[flang] Implement semantics for DEC STRUCTURE/RECORD

[klausler]

Summary

Implements part of the legacy "DEC structures" feature from
VMS Fortran. STRUCTUREs are processed as if they were derived
types with SEQUENCE. DATA-like object entity initialization
is supported as well (e.g., INTEGER FOO/666/) since it was used
for default component initialization in structures. Anonymous
components (named %FILL) are also supported.

These features, and UNION/MAP, were already being parsed.
An omission in the collection of structure field names in the
case of nested structures with entity declarations was fixed
in the parser.

Structures are supported in modules, but this is mostly for
testing purposes. The names of fields in structures accessed
via USE association cannot appear with dot notation in client
code (at least not yet). DEC structures antedate Fortran 90,
so their actual use in applications should not involve modules.

This patch does not implement UNION/MAP, since that feature
would impose difficulties later in lowering them to MLIR types.
In the meantime, if they appear, semantics will issue a
"not yet implemented" error message.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/docs/Extensions.md

 
 * Tabs in source
 * `<>` as synonym for `.NE.` and `/=`
 * `$` and `@` as legal characters in names
 * Initialization in type declaration statements using `/values/`
 * Kind specification with `*`, e.g. `REAL*4`
 * `DOUBLE COMPLEX`
 * Signed complex literal constants
-* DEC `STRUCTURE`, `RECORD`, `UNION`, and `MAP`
+* DEC `STRUCTURE`, `RECORD`, with '%FILL'; but `UNION`, and `MAP`
+  are not yet supported throughout compilation, and elicit a
+  "not yet implemented" message.
 * Structure field access with `.field`
 * `BYTE` as synonym for `INTEGER(KIND=1)`
 * Quad precision REAL literals with `Q`
 * `X` prefix/suffix as synonym for `Z` on hexadecimal literals
 * `B`, `O`, `Z`, and `X` accepted as suffixes as well as prefixes
 * Triplets allowed in array constructors
 * `%LOC`, `%VAL`, and `%REF`
 * Leading comma allowed before I/O item list

flang/include/flang/Common/unwrap.h

struct UnwrapperHelper {
 
   template <typename A, typename B>
   static auto Unwrap(const Reference<B> &ref) -> Constify<A, B> * {
     return Unwrap<A>(*ref);
   }
 
   template <typename A, typename B, bool COPY>
   static auto Unwrap(const Indirection<B, COPY> &p) -> Constify<A, B> * {
-    return Unwrap<A>(*p);
+    return Unwrap<A>(p.value());
   }
 
   template <typename A, typename B>
   static auto Unwrap(const CountedReference<B> &p) -> Constify<A, B> * {
     if (p.get()) {
       return Unwrap<A>(*p);
     } else {
       return nullptr;

flang/include/flang/Parser/dump-parse-tree.h

#include "llvm/Frontend/OpenACC/ACC.inc"
   NODE(CompilerDirective, IgnoreTKR)
   NODE(CompilerDirective, NameValue)
   NODE(parser, ComplexLiteralConstant)
   NODE(parser, ComplexPart)
   NODE(parser, ComponentArraySpec)
   NODE(parser, ComponentAttrSpec)
   NODE(parser, ComponentDataSource)
   NODE(parser, ComponentDecl)
+  NODE(parser, FillDecl)
+  NODE(parser, ComponentOrFill)
   NODE(parser, ComponentDefStmt)
   NODE(parser, ComponentSpec)
   NODE(parser, ComputedGotoStmt)
   NODE(parser, ConcurrentControl)
   NODE(parser, ConcurrentHeader)
   NODE(parser, ConnectSpec)
   NODE(ConnectSpec, CharExpr)
   NODE_ENUM(ConnectSpec::CharExpr, Kind)

flang/include/flang/Parser/parse-tree.h

 struct ComponentDecl {
   TUPLE_CLASS_BOILERPLATE(ComponentDecl);
   std::tuple<Name, std::optional<ComponentArraySpec>,
       std::optional<CoarraySpec>, std::optional<CharLength>,
       std::optional<Initialization>>
       t;
 };
 
+// A %FILL component for a DEC STRUCTURE.  The name will be replaced
+// with a distinct compiler-generated name.
+struct FillDecl {
+  TUPLE_CLASS_BOILERPLATE(FillDecl);
+  std::tuple<Name, std::optional<ComponentArraySpec>, std::optional<CharLength>>
+      t;
+};
+
+struct ComponentOrFill {
+  UNION_CLASS_BOILERPLATE(ComponentOrFill);
+  std::variant<ComponentDecl, FillDecl> u;
+};
+
 // R737 data-component-def-stmt ->
 //        declaration-type-spec [[, component-attr-spec-list] ::]
 //        component-decl-list
 struct DataComponentDefStmt {
   TUPLE_CLASS_BOILERPLATE(DataComponentDefStmt);
   std::tuple<DeclarationTypeSpec, std::list<ComponentAttrSpec>,
-      std::list<ComponentDecl>>
+      std::list<ComponentOrFill>>
       t;
 };
 
 // R742 proc-component-attr-spec ->
 //        access-spec | NOPASS | PASS [(arg-name)] | POINTER
 EMPTY_CLASS(NoPass);
 WRAPPER_CLASS(Pass, std::optional<Name>);
 struct ProcComponentAttrSpec {
struct Union {
   EMPTY_CLASS(UnionStmt);
   EMPTY_CLASS(EndUnionStmt);
   TUPLE_CLASS_BOILERPLATE(Union);
   std::tuple<Statement<UnionStmt>, std::list<Map>, Statement<EndUnionStmt>> t;
 };
 
 struct StructureStmt {
   TUPLE_CLASS_BOILERPLATE(StructureStmt);
-  std::tuple<Name, bool /*slashes*/, std::list<EntityDecl>> t;
+  std::tuple<std::optional<Name>, std::list<EntityDecl>> t;
 };
 
 struct StructureDef {
   EMPTY_CLASS(EndStructureStmt);
   TUPLE_CLASS_BOILERPLATE(StructureDef);
   std::tuple<Statement<StructureStmt>, std::list<StructureField>,
       Statement<EndStructureStmt>>
       t;

flang/include/flang/Parser/tools.h

 const Name &GetLastName(const ProcComponentRef &);
 const Name &GetLastName(const ProcedureDesignator &);
 const Name &GetLastName(const Call &);
 const Name &GetLastName(const FunctionReference &);
 const Name &GetLastName(const Variable &);
 const Name &GetLastName(const AllocateObject &);
 
 // GetFirstName() isolates and returns a reference to the leftmost Name
-// in a variable.
+// in a variable or entity declaration.
 const Name &GetFirstName(const Name &);
 const Name &GetFirstName(const StructureComponent &);
 const Name &GetFirstName(const DataRef &);
 const Name &GetFirstName(const Substring &);
 const Name &GetFirstName(const Designator &);
 const Name &GetFirstName(const ProcComponentRef &);
 const Name &GetFirstName(const ProcedureDesignator &);
 const Name &GetFirstName(const Call &);

flang/include/flang/Parser/user-state.h

struct OldStructureComponentName {
   using resultType = Name;
   static std::optional<Name> Parse(ParseState &);
 };
 
 struct StructureComponents {
   using resultType = DataComponentDefStmt;
   static std::optional<DataComponentDefStmt> Parse(ParseState &);
 };
+
+struct NestedStructureStmt {
+  using resultType = StructureStmt;
+  static std::optional<StructureStmt> Parse(ParseState &);
+};
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_USER_STATE_H_

flang/include/flang/Semantics/expression.h

public:
   MaybeExpr Analyze(const parser::StructureConstructor &);
   MaybeExpr Analyze(const parser::InitialDataTarget &);
   MaybeExpr Analyze(const parser::NullInit &);
 
   void Analyze(const parser::CallStmt &);
   const Assignment *Analyze(const parser::AssignmentStmt &);
   const Assignment *Analyze(const parser::PointerAssignmentStmt &);
 
+  // Builds a typed Designator from an untyped DataRef
+  MaybeExpr Designate(DataRef &&);
+
 protected:
   int IntegerTypeSpecKind(const parser::IntegerTypeSpec &);
 
 private:
   MaybeExpr Analyze(const parser::IntLiteralConstant &);
   MaybeExpr Analyze(const parser::RealLiteralConstant &);
   MaybeExpr Analyze(const parser::ComplexPart &);
   MaybeExpr Analyze(const parser::ComplexLiteralConstant &);
private:
   std::optional<Expr<SubscriptInteger>> TripletPart(
       const std::optional<parser::Subscript> &);
   std::optional<Subscript> AnalyzeSectionSubscript(
       const parser::SectionSubscript &);
   std::vector<Subscript> AnalyzeSectionSubscripts(
       const std::list<parser::SectionSubscript> &);
   std::optional<Component> CreateComponent(
       DataRef &&, const Symbol &, const semantics::Scope &);
-  MaybeExpr Designate(DataRef &&);
   MaybeExpr CompleteSubscripts(ArrayRef &&);
   MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
   MaybeExpr TopLevelChecks(DataRef &&);
   std::optional<Expr<SubscriptInteger>> GetSubstringBound(
       const std::optional<parser::ScalarIntExpr> &);
   MaybeExpr AnalyzeDefinedOp(const parser::Name &, ActualArguments &&);
 
   struct CalleeAndArguments {

flang/include/flang/Semantics/semantics.h

public:
   void CheckIndexVarRedefine(const parser::CharBlock &, const Symbol &);
   void CheckIndexVarRedefine(const parser::Variable &);
   void CheckIndexVarRedefine(const parser::Name &);
   void ActivateIndexVar(const parser::Name &, IndexVarKind);
   void DeactivateIndexVar(const parser::Name &);
   SymbolVector GetIndexVars(IndexVarKind);
   SourceName SaveTempName(std::string &&);
   SourceName GetTempName(const Scope &);
+  static bool IsTempName(const std::string &);
 
   // Locate and process the contents of a built-in module on demand
   Scope *GetBuiltinModule(const char *name);
 
   // Defines builtinsScope_ from the __Fortran_builtins module
   void UseFortranBuiltinsModule();
   const Scope *GetBuiltinsScope() const { return builtinsScope_; }
 

flang/include/flang/Semantics/symbol.h

 // The DerivedTypeSpec instances whose type symbols share these details
 // each own a scope into which the components' symbols have been cloned
 // and specialized for each distinct set of type parameter values.
 class DerivedTypeDetails {
 public:
   const std::list<SourceName> &paramNames() const { return paramNames_; }
   const SymbolVector &paramDecls() const { return paramDecls_; }
   bool sequence() const { return sequence_; }
+  bool isDECStructure() const { return isDECStructure_; }
   std::map<SourceName, SymbolRef> &finals() { return finals_; }
   const std::map<SourceName, SymbolRef> &finals() const { return finals_; }
   bool isForwardReferenced() const { return isForwardReferenced_; }
   void add_paramName(const SourceName &name) { paramNames_.push_back(name); }
   void add_paramDecl(const Symbol &symbol) { paramDecls_.push_back(symbol); }
   void add_component(const Symbol &);
   void set_sequence(bool x = true) { sequence_ = x; }
+  void set_isDECStructure(bool x = true) { isDECStructure_ = x; }
   void set_isForwardReferenced(bool value) { isForwardReferenced_ = value; }
   const std::list<SourceName> &componentNames() const {
     return componentNames_;
   }
 
   // If this derived type extends another, locate the parent component's symbol.
   const Symbol *GetParentComponent(const Scope &) const;
 
private:
   // declarations appear in the derived type definition(s).
   std::list<SourceName> paramNames_;
   SymbolVector paramDecls_;
   // These are the names of the derived type's components in component
   // order.  A parent component, if any, appears first in this list.
   std::list<SourceName> componentNames_;
   std::map<SourceName, SymbolRef> finals_; // FINAL :: subr
   bool sequence_{false};
+  bool isDECStructure_{false};
   bool isForwardReferenced_{false};
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const DerivedTypeDetails &);
 };
 
 class ProcBindingDetails : public WithPassArg {
 public:
   explicit ProcBindingDetails(const Symbol &symbol) : symbol_{symbol} {}
ENUM_CLASS(Flag,
       Implicit, // symbol is implicitly typed
       ImplicitOrError, // symbol must be implicitly typed or it's an error
       ModFile, // symbol came from .mod file
       ParentComp, // symbol is the "parent component" of an extended type
       CrayPointer, CrayPointee,
       LocalityLocal, // named in LOCAL locality-spec
       LocalityLocalInit, // named in LOCAL_INIT locality-spec
       LocalityShared, // named in SHARED locality-spec
-      InDataStmt, // initialized in a DATA statement
-      InNamelist, // flag is set if the symbol is in Namelist statement
+      InDataStmt, // initialized in a DATA statement, =>object, or /init/
+      InNamelist, // in a Namelist group
       CompilerCreated,
       // OpenACC data-sharing attribute
       AccPrivate, AccFirstPrivate, AccShared,
       // OpenACC data-mapping attribute
       AccCopyIn, AccCopyOut, AccCreate, AccDelete, AccPresent,
       // OpenACC miscellaneous flags
       AccCommonBlock, AccThreadPrivate, AccReduction, AccNone, AccPreDetermined,
       // OpenMP data-sharing attribute

flang/lib/Evaluate/fold-designator.cpp

 #include "flang/Semantics/tools.h"
 
 namespace Fortran::evaluate {
 
 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(OffsetSymbol)
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
     const Symbol &symbol, ConstantSubscript which) {
-  if (semantics::IsPointer(symbol) || semantics::IsAllocatable(symbol)) {
+  if (IsAllocatableOrPointer(symbol)) {
     // A pointer may appear as a DATA statement object if it is the
     // rightmost symbol in a designator and has no subscripts.
     // An allocatable may appear if its initializer is NULL().
     if (which > 0) {
       isEmpty_ = true;
     } else {
       return OffsetSymbol{symbol, symbol.size()};
     }
   } else if (symbol.has<semantics::ObjectEntityDetails>() &&
       !IsNamedConstant(symbol)) {
     if (auto type{DynamicType::From(symbol)}) {
       if (auto extents{GetConstantExtents(context_, symbol)}) {
         if (auto bytes{ToInt64(
                 type->MeasureSizeInBytes(context_, GetRank(*extents) > 0))}) {
           OffsetSymbol result{symbol, static_cast<std::size_t>(*bytes)};
-          auto stride{*bytes};
-          for (auto extent : *extents) {
-            if (extent == 0) {
-              return std::nullopt;
-            }
-            auto quotient{which / extent};
-            auto remainder{which - extent * quotient};
-            result.Augment(stride * remainder);
-            which = quotient;
-            stride *= extent;
-          }
-          if (which > 0) {
-            isEmpty_ = true;
+          if (which < GetSize(*extents)) {
+            result.Augment(*bytes * which);
+            return result;
           } else {
-            return std::move(result);
+            isEmpty_ = true;
           }
         }
       }
     }
   }
   return std::nullopt;
 }
 
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
   }
   return std::nullopt;
 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
     const Component &component, ConstantSubscript which) {
   const Symbol &comp{component.GetLastSymbol()};
   const DataRef &base{component.base()};
-  std::optional<OffsetSymbol> result, baseResult;
+  std::optional<OffsetSymbol> baseResult, compResult;
   if (base.Rank() == 0) { // A%X(:) - apply "which" to component
     baseResult = FoldDesignator(base, 0);
-    result = FoldDesignator(comp, which);
+    compResult = FoldDesignator(comp, which);
   } else { // A(:)%X - apply "which" to base
     baseResult = FoldDesignator(base, which);
-    result = FoldDesignator(comp, 0);
+    compResult = FoldDesignator(comp, 0);
   }
-  if (result && baseResult) {
-    result->set_symbol(baseResult->symbol());
-    result->Augment(baseResult->offset() + comp.offset());
-    return result;
+  if (baseResult && compResult) {
+    OffsetSymbol result{baseResult->symbol(), compResult->size()};
+    result.Augment(baseResult->offset() + compResult->offset() + comp.offset());
+    return {std::move(result)};
   } else {
     return std::nullopt;
   }
 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
     const ComplexPart &z, ConstantSubscript which) {
   if (auto result{FoldDesignator(z.complex(), which)}) {

flang/lib/Parser/Fortran-parsers.cpp

construct<DeclarationTypeSpec>(intrinsicTypeSpec) ||
                     "( * )" >> construct<DeclarationTypeSpec::TypeStar>())) ||
         "CLASS" >> parenthesized(construct<DeclarationTypeSpec>(
                                      construct<DeclarationTypeSpec::Class>(
                                          derivedTypeSpec)) ||
                        construct<DeclarationTypeSpec>("*" >>
                            construct<DeclarationTypeSpec::ClassStar>())) ||
         extension<LanguageFeature::DECStructures>(
             construct<DeclarationTypeSpec>(
+                // As is also done for the STRUCTURE statement, the name of
+                // the structure includes the surrounding slashes to avoid
+                // name clashes.
                 construct<DeclarationTypeSpec::Record>(
-                    "RECORD /" >> name / "/"))))
+                    "RECORD" >> sourced("/" >> name / "/")))))
 
 // R704 intrinsic-type-spec ->
 //        integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |
 //        COMPLEX [kind-selector] | CHARACTER [char-selector] |
 //        LOGICAL [kind-selector]
 // Extensions: DOUBLE COMPLEX, BYTE
 TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,
     first(construct<IntrinsicTypeSpec>(integerTypeSpec),
TYPE_PARSER(recovery(
     construct<ComponentDefStmt>(inStmtErrorRecovery)))
 
 // R737 data-component-def-stmt ->
 //        declaration-type-spec [[, component-attr-spec-list] ::]
 //        component-decl-list
 // N.B. The standard requires double colons if there's an initializer.
 TYPE_PARSER(construct<DataComponentDefStmt>(declarationTypeSpec,
     optionalListBeforeColons(Parser<ComponentAttrSpec>{}),
-    nonemptyList(
-        "expected component declarations"_err_en_US, Parser<ComponentDecl>{})))
+    nonemptyList("expected component declarations"_err_en_US,
+        Parser<ComponentOrFill>{})))
 
 // R738 component-attr-spec ->
 //        access-spec | ALLOCATABLE |
 //        CODIMENSION lbracket coarray-spec rbracket |
 //        CONTIGUOUS | DIMENSION ( component-array-spec ) | POINTER
 TYPE_PARSER(construct<ComponentAttrSpec>(accessSpec) ||
     construct<ComponentAttrSpec>(allocatable) ||
     construct<ComponentAttrSpec>("CODIMENSION" >> coarraySpec) ||
     construct<ComponentAttrSpec>(contiguous) ||
     construct<ComponentAttrSpec>("DIMENSION" >> Parser<ComponentArraySpec>{}) ||
     construct<ComponentAttrSpec>(pointer) ||
     construct<ComponentAttrSpec>(recovery(
         fail<ErrorRecovery>(
             "type parameter definitions must appear before component declarations"_err_en_US),
         kindOrLen >> construct<ErrorRecovery>())))
 
 // R739 component-decl ->
 //        component-name [( component-array-spec )]
 //        [lbracket coarray-spec rbracket] [* char-length]
 //        [component-initialization]
 TYPE_CONTEXT_PARSER("component declaration"_en_US,
     construct<ComponentDecl>(name, maybe(Parser<ComponentArraySpec>{}),
         maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization)))
+// The source field of the Name will be replaced with a distinct generated name.
+TYPE_CONTEXT_PARSER("%FILL item"_en_US,
+    extension<LanguageFeature::DECStructures>(
+        construct<FillDecl>(space >> sourced("%FILL" >> construct<Name>()),
+            maybe(Parser<ComponentArraySpec>{}), maybe("*" >> charLength))))
+TYPE_PARSER(construct<ComponentOrFill>(Parser<ComponentDecl>{}) ||
+    construct<ComponentOrFill>(Parser<FillDecl>{}))
 
 // R740 component-array-spec ->
 //        explicit-shape-spec-list | deferred-shape-spec-list
 // N.B. Parenthesized here rather than around references to this production.
 TYPE_PARSER(construct<ComponentArraySpec>(parenthesized(
                 nonemptyList("expected explicit shape specifications"_err_en_US,
                     explicitShapeSpec))) ||
     construct<ComponentArraySpec>(parenthesized(deferredShapeSpecList)))
sourced(construct<CompilerDirective>(ignore_tkr) ||
                           maybe(("="_tok || ":"_tok) >> digitString64))))) /
         endDirective)
 
 TYPE_PARSER(extension<LanguageFeature::CrayPointer>(construct<BasedPointerStmt>(
     "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US,
                      construct<BasedPointer>("(" >> objectName / ",",
                          objectName, maybe(Parser<ArraySpec>{}) / ")")))))
 
-TYPE_PARSER(construct<StructureStmt>("STRUCTURE /" >> name / "/", pure(true),
-                optionalList(entityDecl)) ||
-    construct<StructureStmt>(
-        "STRUCTURE" >> name, pure(false), pure<std::list<EntityDecl>>()))
+// Subtle: the name includes the surrounding slashes, which avoids
+// clashes with other uses of the name in the same scope.
+TYPE_PARSER(construct<StructureStmt>(
+    "STRUCTURE" >> maybe(sourced("/" >> name / "/")), optionalList(entityDecl)))
+
+constexpr auto nestedStructureDef{
+    CONTEXT_PARSER("nested STRUCTURE definition"_en_US,
+        construct<StructureDef>(statement(NestedStructureStmt{}),
+            many(Parser<StructureField>{}),
+            statement(construct<StructureDef::EndStructureStmt>(
+                "END STRUCTURE"_tok))))};
 
 TYPE_PARSER(construct<StructureField>(statement(StructureComponents{})) ||
     construct<StructureField>(indirect(Parser<Union>{})) ||
-    construct<StructureField>(indirect(Parser<StructureDef>{})))
+    construct<StructureField>(indirect(nestedStructureDef)))
 
 TYPE_CONTEXT_PARSER("STRUCTURE definition"_en_US,
     extension<LanguageFeature::DECStructures>(construct<StructureDef>(
         statement(Parser<StructureStmt>{}), many(Parser<StructureField>{}),
         statement(
             construct<StructureDef::EndStructureStmt>("END STRUCTURE"_tok)))))
 
 TYPE_CONTEXT_PARSER("UNION definition"_en_US,

flang/lib/Parser/unparse.cpp

public:
   }
   void Unparse(const TypeParamDecl &x) { // R733
     Walk(std::get<Name>(x.t));
     Walk("=", std::get<std::optional<ScalarIntConstantExpr>>(x.t));
   }
   void Unparse(const DataComponentDefStmt &x) { // R737
     const auto &dts{std::get<DeclarationTypeSpec>(x.t)};
     const auto &attrs{std::get<std::list<ComponentAttrSpec>>(x.t)};
-    const auto &decls{std::get<std::list<ComponentDecl>>(x.t)};
+    const auto &decls{std::get<std::list<ComponentOrFill>>(x.t)};
     Walk(dts), Walk(", ", attrs, ", ");
     if (!attrs.empty() ||
         (!std::holds_alternative<DeclarationTypeSpec::Record>(dts.u) &&
             std::none_of(
-                decls.begin(), decls.end(), [](const ComponentDecl &d) {
+                decls.begin(), decls.end(), [](const ComponentOrFill &c) {
+                  return std::visit(
+                      common::visitors{
+                          [](const ComponentDecl &d) {
                             const auto &init{
                                 std::get<std::optional<Initialization>>(d.t)};
                             return init &&
-                      std::holds_alternative<
-                          std::list<common::Indirection<DataStmtValue>>>(
+                                std::holds_alternative<std::list<
+                                    common::Indirection<DataStmtValue>>>(
                                     init->u);
+                          },
+                          [](const FillDecl &) { return false; },
+                      },
+                      c.u);
                 }))) {
       Put(" ::");
     }
     Put(' '), Walk(decls, ", ");
   }
   void Unparse(const Allocatable &) { // R738
     Word("ALLOCATABLE");
   }
public:
   }
   void Unparse(const ComponentDecl &x) { // R739
     Walk(std::get<ObjectName>(x.t));
     Walk("(", std::get<std::optional<ComponentArraySpec>>(x.t), ")");
     Walk("[", std::get<std::optional<CoarraySpec>>(x.t), "]");
     Walk("*", std::get<std::optional<CharLength>>(x.t));
     Walk(std::get<std::optional<Initialization>>(x.t));
   }
+  void Unparse(const FillDecl &x) { // DEC extension
+    Put("%FILL");
+    Walk("(", std::get<std::optional<ComponentArraySpec>>(x.t), ")");
+    Walk("*", std::get<std::optional<CharLength>>(x.t));
+  }
   void Unparse(const ComponentArraySpec &x) { // R740
     std::visit(common::visitors{
                    [&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
                    [&](const DeferredShapeSpecList &y) { Walk(y); },
                },
         x.u);
   }
   void Unparse(const ProcComponentDefStmt &x) { // R741
#include "llvm/Frontend/OpenMP/OMP.inc"
   }
   void Unparse(const BasedPointer &x) {
     Put('('), Walk(std::get<0>(x.t)), Put(","), Walk(std::get<1>(x.t));
     Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"), Put(')');
   }
   void Unparse(const BasedPointerStmt &x) { Walk("POINTER ", x.v, ","); }
   void Post(const StructureField &x) {
     if (const auto *def{std::get_if<Statement<DataComponentDefStmt>>(&x.u)}) {
-      for (const auto &decl :
-          std::get<std::list<ComponentDecl>>(def->statement.t)) {
-        structureComponents_.insert(std::get<Name>(decl.t).source);
+      for (const auto &item :
+          std::get<std::list<ComponentOrFill>>(def->statement.t)) {
+        if (const auto *comp{std::get_if<ComponentDecl>(&item.u)}) {
+          structureComponents_.insert(std::get<Name>(comp->t).source);
+        }
       }
     }
   }
   void Unparse(const StructureStmt &x) {
     Word("STRUCTURE ");
-    if (std::get<bool>(x.t)) { // slashes around name
-      Put('/'), Walk(std::get<Name>(x.t)), Put('/');
-      Walk(" ", std::get<std::list<EntityDecl>>(x.t), ", ");
-    } else {
-      CHECK(std::get<std::list<EntityDecl>>(x.t).empty());
-      Walk(std::get<Name>(x.t));
-    }
+    // The name, if present, includes the /slashes/
+    Walk(std::get<std::optional<Name>>(x.t));
     Indent();
   }
   void Post(const Union::UnionStmt &) { Word("UNION"), Indent(); }
   void Post(const Union::EndUnionStmt &) { Outdent(), Word("END UNION"); }
   void Post(const Map::MapStmt &) { Word("MAP"), Indent(); }
   void Post(const Map::EndMapStmt &) { Outdent(), Word("END MAP"); }
   void Post(const StructureDef::EndStructureStmt &) {
     Outdent(), Word("END STRUCTURE");

flang/lib/Parser/user-state.cpp

 
 std::optional<Success> LeaveDoConstruct::Parse(ParseState &state) {
   if (auto ustate{state.userState()}) {
     ustate->LeaveDoConstruct();
   }
   return {Success{}};
 }
 
+// These special parsers for bits of DEC STRUCTURE capture the names of
+// their components and nested structures in the user state so that
+// references to these fields with periods can be recognized as special
+// cases.
+
 std::optional<Name> OldStructureComponentName::Parse(ParseState &state) {
   if (std::optional<Name> n{name.Parse(state)}) {
     if (const auto *ustate{state.userState()}) {
       if (ustate->IsOldStructureComponent(n->source)) {
         return n;
       }
     }
   }
   return std::nullopt;
 }
 
 std::optional<DataComponentDefStmt> StructureComponents::Parse(
     ParseState &state) {
   static constexpr auto stmt{Parser<DataComponentDefStmt>{}};
   std::optional<DataComponentDefStmt> defs{stmt.Parse(state)};
   if (defs) {
     if (auto *ustate{state.userState()}) {
-      for (const auto &decl : std::get<std::list<ComponentDecl>>(defs->t)) {
-        ustate->NoteOldStructureComponent(std::get<Name>(decl.t).source);
+      for (const auto &item : std::get<std::list<ComponentOrFill>>(defs->t)) {
+        if (const auto *decl{std::get_if<ComponentDecl>(&item.u)}) {
+          ustate->NoteOldStructureComponent(std::get<Name>(decl->t).source);
+        }
       }
     }
   }
   return defs;
 }
+
+std::optional<StructureStmt> NestedStructureStmt::Parse(ParseState &state) {
+  std::optional<StructureStmt> stmt{Parser<StructureStmt>{}.Parse(state)};
+  if (stmt) {
+    if (auto *ustate{state.userState()}) {
+      for (const auto &entity : std::get<std::list<EntityDecl>>(stmt->t)) {
+        ustate->NoteOldStructureComponent(std::get<Name>(entity.t).source);
+      }
+    }
+  }
+  return stmt;
+}
 } // namespace Fortran::parser

flang/lib/Semantics/check-data.h

 class DataChecker : public virtual BaseChecker {
 public:
   explicit DataChecker(SemanticsContext &context) : exprAnalyzer_{context} {}
   void Leave(const parser::DataStmtObject &);
   void Leave(const parser::DataIDoObject &);
   void Enter(const parser::DataImpliedDo &);
   void Leave(const parser::DataImpliedDo &);
   void Leave(const parser::DataStmtSet &);
+  // These cases are for legacy DATA-like /initializations/
+  void Leave(const parser::ComponentDecl &);
+  void Leave(const parser::EntityDecl &);
 
   // After all DATA statements have been processed, converts their
   // initializations into per-symbol static initializers.
   void CompileDataInitializationsIntoInitializers();
 
 private:
   ConstantSubscript GetRepetitionCount(const parser::DataStmtRepeat &);
   template <typename T> void CheckIfConstantSubscript(const T &);
   void CheckSubscript(const parser::SectionSubscript &);
   bool CheckAllSubscriptsInDataRef(const parser::DataRef &, parser::CharBlock);
+  template <typename A> void LegacyDataInit(const A &);
 
   DataInitializations inits_;
   evaluate::ExpressionAnalyzer exprAnalyzer_;
   bool currentSetHasFatalErrors_{false};
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_DATA_H_

flang/lib/Semantics/check-data.cpp

 
 void DataChecker::Leave(const parser::DataStmtSet &set) {
   if (!currentSetHasFatalErrors_) {
     AccumulateDataInitializations(inits_, exprAnalyzer_, set);
   }
   currentSetHasFatalErrors_ = false;
 }
 
+// Handle legacy DATA-style initialization, e.g. REAL PI/3.14159/, for
+// variables and components (esp. for DEC STRUCTUREs)
+template <typename A> void DataChecker::LegacyDataInit(const A &decl) {
+  if (const auto &init{
+          std::get<std::optional<parser::Initialization>>(decl.t)}) {
+    const Symbol *name{std::get<parser::Name>(decl.t).symbol};
+    const auto *list{
+        std::get_if<std::list<common::Indirection<parser::DataStmtValue>>>(
+            &init->u)};
+    if (name && list) {
+      AccumulateDataInitializations(inits_, exprAnalyzer_, *name, *list);
+    }
+  }
+}
+
+void DataChecker::Leave(const parser::ComponentDecl &decl) {
+  LegacyDataInit(decl);
+}
+
+void DataChecker::Leave(const parser::EntityDecl &decl) {
+  LegacyDataInit(decl);
+}
+
 void DataChecker::CompileDataInitializationsIntoInitializers() {
   ConvertToInitializers(inits_, exprAnalyzer_);
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/data-to-inits.h

 #include "flang/Common/default-kinds.h"
 #include "flang/Common/interval.h"
 #include "flang/Evaluate/initial-image.h"
 #include <list>
 #include <map>
 
 namespace Fortran::parser {
 struct DataStmtSet;
+struct DataStmtValue;
 }
 namespace Fortran::evaluate {
 class ExpressionAnalyzer;
 }
 namespace Fortran::semantics {
 
 class Symbol;
 
 struct SymbolDataInitialization {
   using Range = common::Interval<common::ConstantSubscript>;
   explicit SymbolDataInitialization(std::size_t bytes) : image{bytes} {}
   SymbolDataInitialization(SymbolDataInitialization &&) = default;
   evaluate::InitialImage image;
   std::list<Range> initializedRanges;
 };
 
 using DataInitializations = std::map<const Symbol *, SymbolDataInitialization>;
 
 // Matches DATA statement variables with their values and checks
 // compatibility.
 void AccumulateDataInitializations(DataInitializations &,
     evaluate::ExpressionAnalyzer &, const parser::DataStmtSet &);
 
+// For legacy DATA-style initialization extension: integer n(2)/1,2/
+void AccumulateDataInitializations(DataInitializations &,
+    evaluate::ExpressionAnalyzer &, const Symbol &,
+    const std::list<common::Indirection<parser::DataStmtValue>> &);
+
 void ConvertToInitializers(
     DataInitializations &, evaluate::ExpressionAnalyzer &);
 
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_DATA_TO_INITS_H_

flang/lib/Semantics/data-to-inits.cpp

 // Whether to delete the original "init()" initializers from storage-associated
 // objects and pointers.
 static constexpr bool removeOriginalInits{false};
 
 namespace Fortran::semantics {
 
 // Steps through a list of values in a DATA statement set; implements
 // repetition.
-class ValueListIterator {
+template <typename DSV = parser::DataStmtValue> class ValueListIterator {
 public:
-  explicit ValueListIterator(const parser::DataStmtSet &set)
-      : end_{std::get<std::list<parser::DataStmtValue>>(set.t).end()},
-        at_{std::get<std::list<parser::DataStmtValue>>(set.t).begin()} {
+  explicit ValueListIterator(const std::list<DSV> &list)
+      : end_{list.end()}, at_{list.begin()} {
     SetRepetitionCount();
   }
   bool hasFatalError() const { return hasFatalError_; }
   bool IsAtEnd() const { return at_ == end_; }
   const SomeExpr *operator*() const { return GetExpr(GetConstant()); }
   parser::CharBlock LocateSource() const { return GetConstant().source; }
   ValueListIterator &operator++() {
     if (repetitionsRemaining_ > 0) {
       --repetitionsRemaining_;
     } else if (at_ != end_) {
       ++at_;
       SetRepetitionCount();
     }
     return *this;
   }
 
 private:
-  using listIterator = std::list<parser::DataStmtValue>::const_iterator;
+  using listIterator = typename std::list<DSV>::const_iterator;
   void SetRepetitionCount();
+  const parser::DataStmtValue &GetValue() const {
+    return DEREF(common::Unwrap<const parser::DataStmtValue>(*at_));
+  }
   const parser::DataStmtConstant &GetConstant() const {
-    return std::get<parser::DataStmtConstant>(at_->t);
+    return std::get<parser::DataStmtConstant>(GetValue().t);
   }
 
-  listIterator end_;
-  listIterator at_;
+  listIterator end_, at_;
   ConstantSubscript repetitionsRemaining_{0};
   bool hasFatalError_{false};
 };
 
-void ValueListIterator::SetRepetitionCount() {
+template <typename DSV> void ValueListIterator<DSV>::SetRepetitionCount() {
   for (repetitionsRemaining_ = 1; at_ != end_; ++at_) {
-    if (at_->repetitions < 0) {
+    auto repetitions{GetValue().repetitions};
+    if (repetitions < 0) {
       hasFatalError_ = true;
-    }
-    if (at_->repetitions > 0) {
-      repetitionsRemaining_ = at_->repetitions - 1;
+    } else if (repetitions > 0) {
+      repetitionsRemaining_ = repetitions - 1;
       return;
     }
   }
   repetitionsRemaining_ = 0;
 }
 
 // Collects all of the elemental initializations from DATA statements
 // into a single image for each symbol that appears in any DATA.
 // Expands the implied DO loops and array references.
 // Applies checks that validate each distinct elemental initialization
 // of the variables in a data-stmt-set, as well as those that apply
-// to the corresponding values being use to initialize each element.
+// to the corresponding values being used to initialize each element.
+template <typename DSV = parser::DataStmtValue>
 class DataInitializationCompiler {
 public:
   DataInitializationCompiler(DataInitializations &inits,
-      evaluate::ExpressionAnalyzer &a, const parser::DataStmtSet &set)
-      : inits_{inits}, exprAnalyzer_{a}, values_{set} {}
+      evaluate::ExpressionAnalyzer &a, const std::list<DSV> &list)
+      : inits_{inits}, exprAnalyzer_{a}, values_{list} {}
   const DataInitializations &inits() const { return inits_; }
   bool HasSurplusValues() const { return !values_.IsAtEnd(); }
   bool Scan(const parser::DataStmtObject &);
+  // Initializes all elements of whole variable or component
+  bool Scan(const Symbol &);
 
 private:
   bool Scan(const parser::Variable &);
   bool Scan(const parser::Designator &);
   bool Scan(const parser::DataImpliedDo &);
   bool Scan(const parser::DataIDoObject &);
 
   // Initializes all elements of a designator, which can be an array or section.
   bool InitDesignator(const SomeExpr &);
-  // Initializes a single object.
+  // Initializes a single scalar object.
   bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator);
   // If the returned flag is true, emit a warning about CHARACTER misusage.
   std::optional<std::pair<SomeExpr, bool>> ConvertElement(
       const SomeExpr &, const evaluate::DynamicType &);
 
   DataInitializations &inits_;
   evaluate::ExpressionAnalyzer &exprAnalyzer_;
-  ValueListIterator values_;
+  ValueListIterator<DSV> values_;
 };
 
-bool DataInitializationCompiler::Scan(const parser::DataStmtObject &object) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(
+    const parser::DataStmtObject &object) {
   return std::visit(
       common::visitors{
           [&](const common::Indirection<parser::Variable> &var) {
             return Scan(var.value());
           },
           [&](const parser::DataImpliedDo &ido) { return Scan(ido); },
       },
       object.u);
 }
 
-bool DataInitializationCompiler::Scan(const parser::Variable &var) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(const parser::Variable &var) {
   if (const auto *expr{GetExpr(var)}) {
     exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource());
     if (InitDesignator(*expr)) {
       return true;
     }
   }
   return false;
 }
 
-bool DataInitializationCompiler::Scan(const parser::Designator &designator) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(
+    const parser::Designator &designator) {
   if (auto expr{exprAnalyzer_.Analyze(designator)}) {
     exprAnalyzer_.GetFoldingContext().messages().SetLocation(
         parser::FindSourceLocation(designator));
     if (InitDesignator(*expr)) {
       return true;
     }
   }
   return false;
 }
 
-bool DataInitializationCompiler::Scan(const parser::DataImpliedDo &ido) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(const parser::DataImpliedDo &ido) {
   const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
   auto name{bounds.name.thing.thing};
   const auto *lowerExpr{GetExpr(bounds.lower.thing.thing)};
   const auto *upperExpr{GetExpr(bounds.upper.thing.thing)};
   const auto *stepExpr{
       bounds.step ? GetExpr(bounds.step->thing.thing) : nullptr};
   if (lowerExpr && upperExpr) {
     // Fold the bounds expressions (again) in case any of them depend
if (lower && upper) {
         exprAnalyzer_.RemoveImpliedDo(name.source);
         return result;
       }
     }
   }
   return false;
 }
 
-bool DataInitializationCompiler::Scan(const parser::DataIDoObject &object) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(
+    const parser::DataIDoObject &object) {
   return std::visit(
       common::visitors{
           [&](const parser::Scalar<common::Indirection<parser::Designator>>
                   &var) { return Scan(var.thing.value()); },
           [&](const common::Indirection<parser::DataImpliedDo> &ido) {
             return Scan(ido.value());
           },
       },
       object.u);
 }
 
-bool DataInitializationCompiler::InitDesignator(const SomeExpr &designator) {
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::Scan(const Symbol &symbol) {
+  auto designator{exprAnalyzer_.Designate(evaluate::DataRef{symbol})};
+  CHECK(designator.has_value());
+  return InitDesignator(*designator);
+}
+
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::InitDesignator(
+    const SomeExpr &designator) {
   evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
   evaluate::DesignatorFolder folder{context};
   while (auto offsetSymbol{folder.FoldDesignator(designator)}) {
     if (folder.isOutOfRange()) {
       if (auto bad{evaluate::OffsetToDesignator(context, *offsetSymbol)}) {
         exprAnalyzer_.context().Say(
             "DATA statement designator '%s' is out of range"_err_en_US,
             bad->AsFortran());
       } else {
         exprAnalyzer_.context().Say(
             "DATA statement designator '%s' is out of range"_err_en_US,
             designator.AsFortran());
       }
       return false;
     } else if (!InitElement(*offsetSymbol, designator)) {
       return false;
     } else {
       ++values_;
     }
   }
   return folder.isEmpty();
 }
 
+template <typename DSV>
 std::optional<std::pair<SomeExpr, bool>>
-DataInitializationCompiler::ConvertElement(
+DataInitializationCompiler<DSV>::ConvertElement(
     const SomeExpr &expr, const evaluate::DynamicType &type) {
   if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
     return {std::make_pair(std::move(*converted), false)};
   }
   if (std::optional<std::string> chValue{
           evaluate::GetScalarConstantValue<evaluate::Ascii>(expr)}) {
     // Allow DATA initialization with Hollerith and kind=1 CHARACTER like
     // (most) other Fortran compilers do.  Pad on the right with spaces
if (std::optional<std::string> chValue{
     }
     if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) {
       return {std::make_pair(std::move(*converted), true)};
     }
   }
   return std::nullopt;
 }
 
-bool DataInitializationCompiler::InitElement(
+template <typename DSV>
+bool DataInitializationCompiler<DSV>::InitElement(
     const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) {
   const Symbol &symbol{offsetSymbol.symbol()};
   const Symbol *lastSymbol{GetLastSymbol(designator)};
   bool isPointer{lastSymbol && IsPointer(*lastSymbol)};
   bool isProcPointer{lastSymbol && IsProcedurePointer(*lastSymbol)};
   evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
   auto restorer{context.messages().SetLocation(values_.LocateSource())};
 
if (!expr) {
     CHECK(exprAnalyzer_.context().AnyFatalError());
   }
   return false;
 }
 
 void AccumulateDataInitializations(DataInitializations &inits,
     evaluate::ExpressionAnalyzer &exprAnalyzer,
     const parser::DataStmtSet &set) {
-  DataInitializationCompiler scanner{inits, exprAnalyzer, set};
+  DataInitializationCompiler scanner{
+      inits, exprAnalyzer, std::get<std::list<parser::DataStmtValue>>(set.t)};
   for (const auto &object :
       std::get<std::list<parser::DataStmtObject>>(set.t)) {
     if (!scanner.Scan(object)) {
       return;
     }
   }
   if (scanner.HasSurplusValues()) {
     exprAnalyzer.context().Say(
         "DATA statement set has more values than objects"_err_en_US);
   }
 }
 
+void AccumulateDataInitializations(DataInitializations &inits,
+    evaluate::ExpressionAnalyzer &exprAnalyzer, const Symbol &symbol,
+    const std::list<common::Indirection<parser::DataStmtValue>> &list) {
+  DataInitializationCompiler<common::Indirection<parser::DataStmtValue>>
+      scanner{inits, exprAnalyzer, list};
+  if (scanner.Scan(symbol) && scanner.HasSurplusValues()) {
+    exprAnalyzer.context().Say(
+        "DATA statement set has more values than objects"_err_en_US);
+  }
+}
+
 // Looks for default derived type component initialization -- but
 // *not* allocatables.
 static const DerivedTypeSpec *HasDefaultInitialization(const Symbol &symbol) {
   if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
     if (object->init().has_value()) {
       return nullptr; // init is explicit, not default
     } else if (!object->isDummy() && object->type()) {
       if (const DerivedTypeSpec * derived{object->type()->AsDerived()}) {

flang/lib/Semantics/mod-file.h

 //===-- lib/Semantics/mod-file.h --------------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_SEMANTICS_MOD_FILE_H_
 #define FORTRAN_SEMANTICS_MOD_FILE_H_
 
 #include "flang/Semantics/attr.h"
+#include "flang/Semantics/symbol.h"
 #include "llvm/Support/raw_ostream.h"
 #include <string>
 
 namespace Fortran::parser {
 class CharBlock;
 class Message;
 class MessageFixedText;
 } // namespace Fortran::parser

 
 private:
   SemanticsContext &context_;
   // Buffer to use with raw_string_ostream
   std::string usesBuf_;
   std::string useExtraAttrsBuf_;
   std::string declsBuf_;
   std::string containsBuf_;
+  // Tracks nested DEC structures and fields of that type
+  UnorderedSymbolSet emittedDECStructures_, emittedDECFields_;
 
   llvm::raw_string_ostream uses_{usesBuf_};
   llvm::raw_string_ostream useExtraAttrs_{
       useExtraAttrsBuf_}; // attrs added to used entity
   llvm::raw_string_ostream decls_{declsBuf_};
   llvm::raw_string_ostream contains_{containsBuf_};
 
   void WriteAll(const Scope &);
   void WriteOne(const Scope &);
   void Write(const Symbol &);
   std::string GetAsString(const Symbol &);
+  void PutSymbols(const Scope &);
   // Returns true if a derived type with bindings and "contains" was emitted
-  bool PutSymbols(const Scope &);
+  bool PutComponents(const Symbol &);
   void PutSymbol(llvm::raw_ostream &, const Symbol &);
-  void PutDerivedType(const Symbol &);
+  void PutEntity(llvm::raw_ostream &, const Symbol &);
+  void PutEntity(
+      llvm::raw_ostream &, const Symbol &, std::function<void()>, Attrs);
+  void PutObjectEntity(llvm::raw_ostream &, const Symbol &);
+  void PutProcEntity(llvm::raw_ostream &, const Symbol &);
+  void PutDerivedType(const Symbol &, const Scope * = nullptr);
+  void PutDECStructure(const Symbol &, const Scope * = nullptr);
+  void PutTypeParam(llvm::raw_ostream &, const Symbol &);
   void PutSubprogram(const Symbol &);
   void PutGeneric(const Symbol &);
   void PutUse(const Symbol &);
   void PutUseExtraAttr(Attr, const Symbol &, const Symbol &);
 };
 
 class ModFileReader {
 public:

flang/lib/Semantics/mod-file.cpp

struct ModHeader {
   static constexpr int sumLen{16};
   static constexpr const char magic[magicLen + 1]{"!mod$ v1 sum:"};
   static constexpr char terminator{'\n'};
   static constexpr int len{magicLen + 1 + sumLen};
 };
 
 static std::optional<SourceName> GetSubmoduleParent(const parser::Program &);
 static void CollectSymbols(const Scope &, SymbolVector &, SymbolVector &);
-static void PutEntity(llvm::raw_ostream &, const Symbol &);
-static void PutObjectEntity(llvm::raw_ostream &, const Symbol &);
-static void PutProcEntity(llvm::raw_ostream &, const Symbol &);
 static void PutPassName(llvm::raw_ostream &, const std::optional<SourceName> &);
-static void PutTypeParam(llvm::raw_ostream &, const Symbol &);
-static void PutEntity(
-    llvm::raw_ostream &, const Symbol &, std::function<void()>, Attrs);
 static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &);
 static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &);
 static void PutBound(llvm::raw_ostream &, const Bound &);
+static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &);
+static void PutShape(
+    llvm::raw_ostream &, const ArraySpec &, char open, char close);
 llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs,
     const std::string * = nullptr, std::string before = ","s,
     std::string after = ""s);
 
 static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);
 static llvm::raw_ostream &PutType(llvm::raw_ostream &, const DeclTypeSpec &);
 static llvm::raw_ostream &PutLower(llvm::raw_ostream &, const std::string &);
 static std::error_code WriteFile(
std::string ModFileWriter::GetAsString(const Symbol &symbol) {
   if (!str.empty()) {
     all << "contains\n" << str;
   }
   all << "end\n";
   return all.str();
 }
 
 // Put out the visible symbols from scope.
-bool ModFileWriter::PutSymbols(const Scope &scope) {
+void ModFileWriter::PutSymbols(const Scope &scope) {
   SymbolVector sorted;
   SymbolVector uses;
   CollectSymbols(scope, sorted, uses);
   std::string buf; // stuff after CONTAINS in derived type
   llvm::raw_string_ostream typeBindings{buf};
   for (const Symbol &symbol : sorted) {
     if (!symbol.test(Symbol::Flag::CompilerCreated)) {
       PutSymbol(typeBindings, symbol);
if (!set.empty() &&
       decls_ << "equivalence";
       for (const auto &object : set) {
         decls_ << punctuation << object.AsFortran();
         punctuation = ',';
       }
       decls_ << ")\n";
     }
   }
+  CHECK(typeBindings.str().empty());
+}
+
+// Emit components in order
+bool ModFileWriter::PutComponents(const Symbol &typeSymbol) {
+  const auto &scope{DEREF(typeSymbol.scope())};
+  std::string buf; // stuff after CONTAINS in derived type
+  llvm::raw_string_ostream typeBindings{buf};
+  UnorderedSymbolSet emitted;
+  SymbolVector symbols{scope.GetSymbols()};
+  // Emit type parameters first
+  for (const Symbol &symbol : symbols) {
+    if (symbol.has<TypeParamDetails>()) {
+      PutSymbol(typeBindings, symbol);
+      emitted.emplace(symbol);
+    }
+  }
+  // Emit components in component order.
+  const auto &details{typeSymbol.get<DerivedTypeDetails>()};
+  for (SourceName name : details.componentNames()) {
+    auto iter{scope.find(name)};
+    if (iter != scope.end()) {
+      const Symbol &component{*iter->second};
+      if (!component.test(Symbol::Flag::ParentComp)) {
+        PutSymbol(typeBindings, component);
+      }
+      emitted.emplace(component);
+    }
+  }
+  // Emit remaining symbols from the type's scope
+  for (const Symbol &symbol : symbols) {
+    if (emitted.find(symbol) == emitted.end()) {
+      PutSymbol(typeBindings, symbol);
+    }
+  }
   if (auto str{typeBindings.str()}; !str.empty()) {
     CHECK(scope.IsDerivedType());
     decls_ << "contains\n" << str;
     return true;
   } else {
     return false;
   }
 }
std::visit(common::visitors{
                  },
                  [](const HostAssocDetails &) {},
                  [](const MiscDetails &) {},
                  [&](const auto &) { PutEntity(decls_, symbol); },
              },
       symbol.details());
 }
 
-void ModFileWriter::PutDerivedType(const Symbol &typeSymbol) {
+void ModFileWriter::PutDerivedType(
+    const Symbol &typeSymbol, const Scope *scope) {
   auto &details{typeSymbol.get<DerivedTypeDetails>()};
+  if (details.isDECStructure()) {
+    PutDECStructure(typeSymbol, scope);
+    return;
+  }
   PutAttrs(decls_ << "type", typeSymbol.attrs());
   if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
     decls_ << ",extends(" << extends->name() << ')';
   }
   decls_ << "::" << typeSymbol.name();
-  auto &typeScope{*typeSymbol.scope()};
   if (!details.paramNames().empty()) {
     char sep{'('};
     for (const auto &name : details.paramNames()) {
       decls_ << sep << name;
       sep = ',';
     }
     decls_ << ')';
   }
   decls_ << '\n';
   if (details.sequence()) {
     decls_ << "sequence\n";
   }
-  bool contains{PutSymbols(typeScope)};
+  bool contains{PutComponents(typeSymbol)};
   if (!details.finals().empty()) {
     const char *sep{contains ? "final::" : "contains\nfinal::"};
     for (const auto &pair : details.finals()) {
       decls_ << sep << pair.second->name();
       sep = ",";
     }
     if (*sep == ',') {
       decls_ << '\n';
     }
   }
   decls_ << "end type\n";
 }
 
+void ModFileWriter::PutDECStructure(
+    const Symbol &typeSymbol, const Scope *scope) {
+  if (emittedDECStructures_.find(typeSymbol) != emittedDECStructures_.end()) {
+    return;
+  }
+  if (!scope && context_.IsTempName(typeSymbol.name().ToString())) {
+    return; // defer until used
+  }
+  emittedDECStructures_.insert(typeSymbol);
+  decls_ << "structure ";
+  if (!context_.IsTempName(typeSymbol.name().ToString())) {
+    decls_ << typeSymbol.name();
+  }
+  if (scope && scope->kind() == Scope::Kind::DerivedType) {
+    // Nested STRUCTURE: emit entity declarations right now
+    // on the STRUCTURE statement.
+    bool any{false};
+    for (const auto &ref : scope->GetSymbols()) {
+      const auto *object{ref->detailsIf<ObjectEntityDetails>()};
+      if (object && object->type() &&
+          object->type()->category() == DeclTypeSpec::TypeDerived &&
+          &object->type()->derivedTypeSpec().typeSymbol() == &typeSymbol) {
+        if (any) {
+          decls_ << ',';
+        } else {
+          any = true;
+        }
+        decls_ << ref->name();
+        PutShape(decls_, object->shape(), '(', ')');
+        PutInit(decls_, *ref, object->init());
+        emittedDECFields_.insert(*ref);
+      } else if (any) {
+        break; // any later use of this structure will use RECORD/str/
+      }
+    }
+  }
+  decls_ << '\n';
+  PutComponents(typeSymbol);
+  decls_ << "end structure\n";
+}
+
 // Attributes that may be in a subprogram prefix
 static const Attrs subprogramPrefixAttrs{Attr::ELEMENTAL, Attr::IMPURE,
     Attr::MODULE, Attr::NON_RECURSIVE, Attr::PURE, Attr::RECURSIVE};
 
 void ModFileWriter::PutSubprogram(const Symbol &symbol) {
   auto attrs{symbol.attrs()};
   auto &details{symbol.get<SubprogramDetails>()};
   Attrs bindAttrs{};
void CollectSymbols(
   sorted.insert(sorted.end(), namelist.begin(), namelist.end());
   for (const auto &pair : scope.commonBlocks()) {
     sorted.push_back(*pair.second);
   }
   std::sort(
       sorted.end() - commonSize, sorted.end(), SymbolSourcePositionCompare{});
 }
 
-void PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {
+void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {
   std::visit(
       common::visitors{
           [&](const ObjectEntityDetails &) { PutObjectEntity(os, symbol); },
           [&](const ProcEntityDetails &) { PutProcEntity(os, symbol); },
           [&](const TypeParamDetails &) { PutTypeParam(os, symbol); },
           [&](const auto &) {
             common::die("PutEntity: unexpected details: %s",
                 DetailsToString(symbol.details()).c_str());
for (const auto &shapeSpec : shape) {
         os << ',';
       }
       PutShapeSpec(os, shapeSpec);
     }
     os << close;
   }
 }
 
-void PutObjectEntity(llvm::raw_ostream &os, const Symbol &symbol) {
+void ModFileWriter::PutObjectEntity(
+    llvm::raw_ostream &os, const Symbol &symbol) {
   auto &details{symbol.get<ObjectEntityDetails>()};
+  if (details.type() &&
+      details.type()->category() == DeclTypeSpec::TypeDerived) {
+    const Symbol &typeSymbol{details.type()->derivedTypeSpec().typeSymbol()};
+    if (typeSymbol.get<DerivedTypeDetails>().isDECStructure()) {
+      PutDerivedType(typeSymbol, &symbol.owner());
+      if (emittedDECFields_.find(symbol) != emittedDECFields_.end()) {
+        return; // symbol was emitted on STRUCTURE statement
+      }
+    }
+  }
   PutEntity(
       os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); },
       symbol.attrs());
   PutShape(os, details.shape(), '(', ')');
   PutShape(os, details.coshape(), '[', ']');
   PutInit(os, symbol, details.init());
   os << '\n';
 }
 
-void PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
+void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
   if (symbol.attrs().test(Attr::INTRINSIC)) {
     os << "intrinsic::" << symbol.name() << '\n';
     if (symbol.attrs().test(Attr::PRIVATE)) {
       os << "private::" << symbol.name() << '\n';
     }
     return;
   }
   const auto &details{symbol.get<ProcEntityDetails>()};

 }
 
 void PutPassName(
     llvm::raw_ostream &os, const std::optional<SourceName> &passName) {
   if (passName) {
     os << ",pass(" << *passName << ')';
   }
 }
-void PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
+
+void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
   auto &details{symbol.get<TypeParamDetails>()};
   PutEntity(
       os, symbol,
       [&]() {
         PutType(os, DEREF(symbol.GetType()));
         PutLower(os << ',', common::EnumToString(details.attr()));
       },
       symbol.attrs());
if (x.isStar()) {
     os << ':';
   } else {
     x.GetExplicit()->AsFortran(os);
   }
 }
 
 // Write an entity (object or procedure) declaration.
 // writeType is called to write out the type.
-void PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
+void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
     std::function<void()> writeType, Attrs attrs) {
   writeType();
   PutAttrs(os, attrs, symbol.GetBindName());
+  if (symbol.owner().kind() == Scope::Kind::DerivedType &&
+      context_.IsTempName(symbol.name().ToString())) {
+    os << "::%FILL";
+  } else {
     os << "::" << symbol.name();
   }
+}
 
 // Put out each attribute to os, surrounded by `before` and `after` and
 // mapped to lower case.
 llvm::raw_ostream &PutAttrs(llvm::raw_ostream &os, Attrs attrs,
     const std::string *bindName, std::string before, std::string after) {
   attrs.set(Attr::PUBLIC, false); // no need to write PUBLIC
   attrs.set(Attr::EXTERNAL, false); // no need to write EXTERNAL
   if (bindName) {

flang/lib/Semantics/resolve-names.cpp

public:
   void Post(const parser::CharSelector::LengthAndKind &);
   void Post(const parser::CharLength &);
   void Post(const parser::LengthSelector &);
   bool Pre(const parser::KindParam &);
   bool Pre(const parser::DeclarationTypeSpec::Type &);
   void Post(const parser::DeclarationTypeSpec::Type &);
   bool Pre(const parser::DeclarationTypeSpec::Class &);
   void Post(const parser::DeclarationTypeSpec::Class &);
-  bool Pre(const parser::DeclarationTypeSpec::Record &);
+  void Post(const parser::DeclarationTypeSpec::Record &);
   void Post(const parser::DerivedTypeSpec &);
   bool Pre(const parser::DerivedTypeDef &);
   bool Pre(const parser::DerivedTypeStmt &);
   void Post(const parser::DerivedTypeStmt &);
   bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); }
   void Post(const parser::TypeParamDefStmt &);
   bool Pre(const parser::TypeAttrSpec::Extends &);
   bool Pre(const parser::PrivateStmt &);
   bool Pre(const parser::SequenceStmt &);
   bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); }
   void Post(const parser::ComponentDefStmt &) { EndDecl(); }
   void Post(const parser::ComponentDecl &);
+  void Post(const parser::FillDecl &);
   bool Pre(const parser::ProcedureDeclarationStmt &);
   void Post(const parser::ProcedureDeclarationStmt &);
   bool Pre(const parser::DataComponentDefStmt &); // returns false
   bool Pre(const parser::ProcComponentDefStmt &);
   void Post(const parser::ProcComponentDefStmt &);
   bool Pre(const parser::ProcPointerInit &);
   void Post(const parser::ProcInterface &);
   void Post(const parser::ProcDecl &);
   bool Pre(const parser::TypeBoundProcedurePart &);
   void Post(const parser::TypeBoundProcedurePart &);
   void Post(const parser::ContainsStmt &);
   bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); }
   void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); }
   void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &);
   void Post(const parser::TypeBoundProcedureStmt::WithInterface &);
   void Post(const parser::FinalProcedureStmt &);
   bool Pre(const parser::TypeBoundGenericStmt &);
+  bool Pre(const parser::StructureDef &); // returns false
+  bool Pre(const parser::Union::UnionStmt &);
+  bool Pre(const parser::StructureField &);
+  void Post(const parser::StructureField &);
   bool Pre(const parser::AllocateStmt &);
   void Post(const parser::AllocateStmt &);
   bool Pre(const parser::StructureConstructor &);
   bool Pre(const parser::NamelistStmt::Group &);
   bool Pre(const parser::IoControlSpec &);
   bool Pre(const parser::CommonStmt::Block &);
   bool Pre(const parser::CommonBlockObject &);
   void Post(const parser::CommonBlockObject &);
private:
   // The attribute corresponding to the statement containing an ObjectDecl
   std::optional<Attr> objectDeclAttr_;
   // Info about current character type while walking DeclTypeSpec.
   // Also captures any "*length" specifier on an individual declaration.
   struct {
     std::optional<ParamValue> length;
     std::optional<KindExpr> kind;
   } charInfo_;
-  // Info about current derived type while walking DerivedTypeDef
+  // Info about current derived type or STRUCTURE while walking
+  // DerivedTypeDef / StructureDef
   struct {
     const parser::Name *extends{nullptr}; // EXTENDS(name)
     bool privateComps{false}; // components are private by default
     bool privateBindings{false}; // bindings are private by default
     bool sawContains{false}; // currently processing bindings
     bool sequence{false}; // is a sequence type
     const Symbol *type{nullptr}; // derived type being defined
+    bool isStructure{false}; // is a DEC STRUCTURE
   } derivedTypeInfo_;
   // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is
   // the interface name, if any.
   const parser::Name *interfaceName_{nullptr};
   // Map type-bound generic to binding names of its specific bindings
   std::multimap<Symbol *, const parser::Name *> genericBindings_;
   // Info about current ENUM
   struct EnumeratorState {
void DeclarationVisitor::Post(
   if (auto spec{ResolveDerivedType(typeName)};
       spec && !IsExtensibleType(&*spec)) { // C705
     SayWithDecl(typeName, *typeName.symbol,
         "Non-extensible derived type '%s' may not be used with CLASS"
         " keyword"_err_en_US);
   }
 }
 
-bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Record &) {
-  // TODO
-  return true;
-}
-
 void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
   const auto &typeName{std::get<parser::Name>(x.t)};
   auto spec{ResolveDerivedType(typeName)};
   if (!spec) {
     return;
   }
   bool seenAnyName{false};
   for (const auto &typeParamSpec :
if (const DeclTypeSpec *
     }
     SetDeclTypeSpec(type);
   }
   // Capture the DerivedTypeSpec in the parse tree for use in building
   // structure constructor expressions.
   x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec();
 }
 
+void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) {
+  const auto &typeName{rec.v};
+  if (auto spec{ResolveDerivedType(typeName)}) {
+    spec->CookParameters(GetFoldingContext());
+    spec->EvaluateParameters(context());
+    if (const DeclTypeSpec *
+        extant{currScope().FindInstantiatedDerivedType(
+            *spec, DeclTypeSpec::TypeDerived)}) {
+      SetDeclTypeSpec(*extant);
+    } else {
+      Say(typeName.source, "%s is not a known STRUCTURE"_err_en_US,
+          typeName.source);
+    }
+  }
+}
+
 // The descendents of DerivedTypeDef in the parse tree are visited directly
 // in this Pre() routine so that recursive use of the derived type can be
 // supported in the components.
 bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
   auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)};
   Walk(stmt);
   Walk(std::get<std::list<parser::Statement<parser::TypeParamDefStmt>>>(x.t));
   auto &scope{currScope()};
if (derivedTypeInfo_.sequence) {
     }
     if (!details.paramNames().empty()) { // C740
       Say(stmt.source,
           "A sequence type may not have type parameters"_err_en_US);
     }
     if (derivedTypeInfo_.extends) { // C735
       Say(stmt.source,
           "A sequence type may not have the EXTENDS attribute"_err_en_US);
-    } else {
-      for (const auto &componentName : details.componentNames()) {
-        const Symbol *componentSymbol{scope.FindComponent(componentName)};
-        if (componentSymbol && componentSymbol->has<ObjectEntityDetails>()) {
-          const auto &componentDetails{
-              componentSymbol->get<ObjectEntityDetails>()};
-          const DeclTypeSpec *componentType{componentDetails.type()};
-          if (componentType && // C740
-              !componentType->AsIntrinsic() &&
-              !componentType->IsSequenceType()) {
-            Say(componentSymbol->name(),
-                "A sequence type data component must either be of an"
-                " intrinsic type or a derived sequence type"_err_en_US);
-          }
-        }
-      }
     }
   }
   Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t));
   Walk(std::get<parser::Statement<parser::EndTypeStmt>>(x.t));
   derivedTypeInfo_ = {};
   PopScope();
   return false;
 }
+
 bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) {
   return BeginAttrs();
 }
 void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
   auto &name{std::get<parser::Name>(x.t)};
   // Resolve the EXTENDS() clause before creating the derived
   // type's symbol to foil attempts to recursively extend a type.
   auto *extendsName{derivedTypeInfo_.extends};
if (symbol.has<ObjectEntityDetails>()) {
         Initialization(name, *init, true);
       }
     }
     currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
   }
   ClearArraySpec();
   ClearCoarraySpec();
 }
+void DeclarationVisitor::Post(const parser::FillDecl &x) {
+  // Replace "%FILL" with a distinct generated name
+  const auto &name{std::get<parser::Name>(x.t)};
+  const_cast<SourceName &>(name.source) = context().GetTempName(currScope());
+  if (OkToAddComponent(name)) {
+    auto &symbol{DeclareObjectEntity(name, GetAttrs())};
+    currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
+  }
+  ClearArraySpec();
+}
 bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &) {
   CHECK(!interfaceName_);
   return BeginDecl();
 }
 void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) {
   interfaceName_ = nullptr;
   EndDecl();
 }
 bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
   // Overrides parse tree traversal so as to handle attributes first,
   // so POINTER & ALLOCATABLE enable forward references to derived types.
   Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t));
   set_allowForwardReferenceToDerivedType(
       GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE}));
   Walk(std::get<parser::DeclarationTypeSpec>(x.t));
   set_allowForwardReferenceToDerivedType(false);
-  Walk(std::get<std::list<parser::ComponentDecl>>(x.t));
+  if (derivedTypeInfo_.sequence) { // C740
+    if (const auto *declType{GetDeclTypeSpec()}) {
+      if (!declType->AsIntrinsic() && !declType->IsSequenceType()) {
+        Say("A sequence type data component must either be of an"
+            " intrinsic type or a derived sequence type"_err_en_US);
+      }
+    }
+  }
+  Walk(std::get<std::list<parser::ComponentOrFill>>(x.t));
   return false;
 }
 bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
   CHECK(!interfaceName_);
   return true;
 }
 void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
   interfaceName_ = nullptr;
 }
 bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
   if (auto *name{std::get_if<parser::Name>(&x.u)}) {
     return !NameIsKnownOrIntrinsic(*name);
   }
   return true;
 }
 void DeclarationVisitor::Post(const parser::ProcInterface &x) {
   if (auto *name{std::get_if<parser::Name>(&x.u)}) {
     interfaceName_ = name;
     NoteInterfaceName(*name);
   }
 }
-
 void DeclarationVisitor::Post(const parser::ProcDecl &x) {
   const auto &name{std::get<parser::Name>(x.t)};
   ProcInterface interface;
   if (interfaceName_) {
     interface.set_symbol(*interfaceName_->symbol);
   } else if (auto *type{GetDeclTypeSpec()}) {
     interface.set_type(*type);
   }
bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) {
   }
   for (const parser::Name &bindingName : bindingNames) {
     genericBindings_.emplace(genericSymbol, &bindingName);
   }
   info.Resolve(genericSymbol);
   return false;
 }
 
+// DEC STRUCTUREs are handled thus to allow for nested definitions.
+bool DeclarationVisitor::Pre(const parser::StructureDef &def) {
+  const auto &structureStatement{
+      std::get<parser::Statement<parser::StructureStmt>>(def.t)};
+  auto saveDerivedTypeInfo{derivedTypeInfo_};
+  derivedTypeInfo_ = {};
+  derivedTypeInfo_.isStructure = true;
+  derivedTypeInfo_.sequence = true;
+  Scope *previousStructure{nullptr};
+  if (saveDerivedTypeInfo.isStructure) {
+    previousStructure = &currScope();
+    PopScope();
+  }
+  const parser::StructureStmt &structStmt{structureStatement.statement};
+  const auto &name{std::get<std::optional<parser::Name>>(structStmt.t)};
+  if (!name) {
+    // Construct a distinct generated name for an anonymous structure
+    auto &mutableName{const_cast<std::optional<parser::Name> &>(name)};
+    mutableName.emplace(
+        parser::Name{context().GetTempName(currScope()), nullptr});
+  }
+  auto &symbol{MakeSymbol(*name, DerivedTypeDetails{})};
+  symbol.ReplaceName(name->source);
+  symbol.get<DerivedTypeDetails>().set_sequence(true);
+  symbol.get<DerivedTypeDetails>().set_isDECStructure(true);
+  derivedTypeInfo_.type = &symbol;
+  PushScope(Scope::Kind::DerivedType, &symbol);
+  const auto &fields{std::get<std::list<parser::StructureField>>(def.t)};
+  Walk(fields);
+  PopScope();
+  // Complete the definition
+  DerivedTypeSpec derivedTypeSpec{symbol.name(), symbol};
+  derivedTypeSpec.set_scope(DEREF(symbol.scope()));
+  derivedTypeSpec.CookParameters(GetFoldingContext());
+  derivedTypeSpec.EvaluateParameters(context());
+  DeclTypeSpec &type{currScope().MakeDerivedType(
+      DeclTypeSpec::TypeDerived, std::move(derivedTypeSpec))};
+  type.derivedTypeSpec().Instantiate(currScope());
+  // Restore previous structure definition context, if any
+  derivedTypeInfo_ = saveDerivedTypeInfo;
+  if (previousStructure) {
+    PushScope(*previousStructure);
+  }
+  // Handle any entity declarations on the STRUCTURE statement
+  const auto &decls{std::get<std::list<parser::EntityDecl>>(structStmt.t)};
+  if (!decls.empty()) {
+    BeginDecl();
+    SetDeclTypeSpec(type);
+    Walk(decls);
+    EndDecl();
+  }
+  return false;
+}
+
+bool DeclarationVisitor::Pre(const parser::Union::UnionStmt &) {
+  Say("UNION is not yet supported"_err_en_US); // TODO
+  return true;
+}
+
+bool DeclarationVisitor::Pre(const parser::StructureField &x) {
+  if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
+          x.u)) {
+    BeginDecl();
+  }
+  return true;
+}
+
+void DeclarationVisitor::Post(const parser::StructureField &x) {
+  if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
+          x.u)) {
+    EndDecl();
+  }
+}
+
 bool DeclarationVisitor::Pre(const parser::AllocateStmt &) {
   BeginDeclTypeSpec();
   return true;
 }
 void DeclarationVisitor::Post(const parser::AllocateStmt &) {
   EndDeclTypeSpec();
 }
 
for (const auto &pair : *scope) {
       const Symbol &component{*pair.second};
       if (component.attrs().test(Attr::ALLOCATABLE)) {
         Say2(name,
             "Derived type variable '%s' may not appear in a COMMON block"
             " due to ALLOCATABLE component"_err_en_US,
             component.name(), "Component with ALLOCATABLE attribute"_en_US);
         return;
       }
-      if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) {
-        if (details->init()) {
-          Say2(name,
-              "Derived type variable '%s' may not appear in a COMMON block"
-              " due to component with default initialization"_err_en_US,
-              component.name(), "Component with default initialization"_en_US);
-          return;
-        }
+      const auto *details{component.detailsIf<ObjectEntityDetails>()};
+      if (component.test(Symbol::Flag::InDataStmt) ||
+          (details && details->init())) {
+            "Derived type variable '%s' may not appear in a COMMON block due to component with default initialization"_err_en_US,
+      if (details) {
         if (const auto *type{details->type()}) {
           if (const auto *derived{type->AsDerived()}) {
             CheckCommonBlockDerivedType(name, derived->typeSymbol());
           }
         }
       }
     }
   }
std::visit(
                       "Non-pointer component '%s' initialized with null pointer"_err_en_US);
                 }
               }
             },
             [&](const parser::InitialDataTarget &) {
               // Defer analysis to the end of the specification part
               // so that forward references and attribute checks like SAVE
               // work better.
+              ultimate.set(Symbol::Flag::InDataStmt);
             },
             [&](const std::list<Indirection<parser::DataStmtValue>> &) {
-              // TODO: Need to Walk(init.u); when implementing this case
-              if (inComponentDecl) {
-                Say(name,
-                    "Component '%s' initialized with DATA statement values"_err_en_US);
-              } else {
-                // TODO - DATA statements and DATA-like initialization extension
-              }
+              // Handled later in data-to-inits conversion
+              ultimate.set(Symbol::Flag::InDataStmt);
             },
         },
         init.u);
   }
 }
 
 void DeclarationVisitor::PointerInitialization(
     const parser::Name &name, const parser::InitialDataTarget &target) {

flang/lib/Semantics/runtime-type-info.cpp

const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
   const Symbol *dtSymbol{
       derivedTypeSpec ? &derivedTypeSpec->typeSymbol() : dtScope.symbol()};
   if (!dtSymbol) {
     return nullptr;
   }
   auto locationRestorer{common::ScopedSet(location_, dtSymbol->name())};
   // Check for an existing description that can be imported from a USE'd module
   std::string typeName{dtSymbol->name().ToString()};
-  if (typeName.empty() || typeName[0] == '.') {
+  if (typeName.empty() ||
+      (typeName.front() == '.' && !context_.IsTempName(typeName))) {
     return nullptr;
   }
   std::string distinctName{typeName};
   if (&dtScope != dtSymbol->scope()) {
     distinctName += "."s + std::to_string(anonymousTypes_++);
   }
   std::string dtDescName{".dt."s + distinctName};
   Scope &scope{GetContainingNonDerivedScope(dtScope)};

 
 SourceName RuntimeTableBuilder::SaveObjectName(const std::string &name) {
   return *tables_.names.insert(name).first;
 }
 
 SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget(
     Scope &scope, const std::string &name) {
   CHECK(!name.empty());
-  CHECK(name.front() != '.');
+  CHECK(name.front() != '.' || context_.IsTempName(name));
   ObjectEntityDetails object;
   auto len{static_cast<common::ConstantSubscript>(name.size())};
   if (const auto *spec{scope.FindType(DeclTypeSpec{CharacterTypeSpec{
           ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}}})}) {
     object.set_type(*spec);
   } else {
     object.set_type(scope.MakeCharacterType(
         ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}));

flang/lib/Semantics/semantics.cpp

 }
 
 SourceName SemanticsContext::SaveTempName(std::string &&name) {
   return {*tempNames_.emplace(std::move(name)).first};
 }
 
 SourceName SemanticsContext::GetTempName(const Scope &scope) {
   for (const auto &str : tempNames_) {
-    if (str.size() > 5 && str.substr(0, 5) == ".F18.") {
+    if (IsTempName(str)) {
       SourceName name{str};
       if (scope.find(name) == scope.end()) {
         return name;
       }
     }
   }
   return SaveTempName(".F18."s + std::to_string(tempNames_.size()));
 }
 
+bool SemanticsContext::IsTempName(const std::string &name) {
+  return name.size() > 5 && name.substr(0, 5) == ".F18.";
+}
+
 Scope *SemanticsContext::GetBuiltinModule(const char *name) {
   return ModFileReader{*this}.Read(
       SourceName{name, std::strlen(name)}, nullptr, true /*silence errors*/);
 }
 
 void SemanticsContext::UseFortranBuiltinsModule() {
   if (builtinsScope_ == nullptr) {
     builtinsScope_ = GetBuiltinModule("__fortran_builtins");

flang/lib/Semantics/type.cpp

switch (category_) {
     SWITCH_COVERS_ALL_CASES
   case Numeric:
     return numericTypeSpec().AsFortran();
   case Logical:
     return logicalTypeSpec().AsFortran();
   case Character:
     return characterTypeSpec().AsFortran();
   case TypeDerived:
+    if (derivedTypeSpec()
+            .typeSymbol()
+            .get<DerivedTypeDetails>()
+            .isDECStructure()) {
+      return "RECORD" + derivedTypeSpec().typeSymbol().name().ToString();
+    } else {
       return "TYPE(" + derivedTypeSpec().AsFortran() + ')';
+    }
   case ClassDerived:
     return "CLASS(" + derivedTypeSpec().AsFortran() + ')';
   case TypeStar:
     return "TYPE(*)";
   case ClassStar:
     return "CLASS(*)";
   }
 }

flang/test/Semantics/modfile42.f90

+! RUN: %python %S/test_modfile.py %s %flang_fc1
+! Check legacy DEC structures
+module m
+  structure /s1/
+    integer n/1/
+    integer na(2)/2,3/
+    structure /s1a/ m, ma(2)
+      integer j/4/
+      integer ja(2)/5,6/
+    end structure
+    structure m2(2), m3 ! anonymous
+      integer k/7/
+      integer %fill(3)
+      integer ka(2)/8,9/
+      real %fill(2)
+    end structure
+  end structure
+  record/s1/ ra1, rb1
+  record/s1a/ ra1a
+  common/s1/ foo ! not a name conflict
+  character*8 s1 ! not a name conflict
+  integer t(2) /2*10/ ! DATA-like entity initialization
+end
+
+!Expect: m.mod
+!module m
+!structure /s1/
+!integer(4)::n=1_4
+!integer(4)::na(1_8:2_8)=[INTEGER(4)::2_4,3_4]
+!structure /s1a/m,ma(1_8:2_8)
+!integer(4)::j=4_4
+!integer(4)::ja(1_8:2_8)=[INTEGER(4)::5_4,6_4]
+!end structure
+!structure m2(1_8:2_8),m3
+!integer(4)::k=7_4
+!integer(4)::%FILL(1_8:3_8)
+!integer(4)::ka(1_8:2_8)=[INTEGER(4)::8_4,9_4]
+!real(4)::%FILL(1_8:2_8)
+!end structure
+!end structure
+!record/s1/::ra1
+!record/s1/::rb1
+!record/s1a/::ra1a
+!real(4)::foo
+!character(8_8,1)::s1
+!integer(4)::t(1_8:2_8)
+!common/s1/foo
+!end

flang/test/Semantics/struct01.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for new semantic errors from misuse of the DEC STRUCTURE extension
+program main
+  !ERROR: Derived type '/undeclared/' not found
+  record /undeclared/ var
+  structure /s/
+    !ERROR: /s/ is not a known STRUCTURE
+    record /s/ attemptToRecurse
+    !ERROR: UNION is not yet supported
+    union
+      map
+        integer j
+      end map
+      map
+        real x
+      end map
+    end union
+  end structure
+end

flang/test/Semantics/symbol15.f90

 ! RUN: %python %S/test_symbols.py %s %flang_fc1
 ! Forward references in pointer initializers and TBP bindings.
 
 !DEF: /m Module
 module m
  implicit none
  abstract interface
   !DEF: /m/iface ABSTRACT, PUBLIC (Subroutine) Subprogram
   subroutine iface
   end subroutine
  end interface
  !DEF: /m/op1 POINTER, PUBLIC ObjectEntity REAL(4)
  real, pointer :: op1
  !DEF: /m/op2 POINTER, PUBLIC ObjectEntity REAL(4)
  !DEF: /m/null INTRINSIC, PUBLIC, PURE (Function) ProcEntity
  real, pointer :: op2 => null()
- !DEF: /m/op3 POINTER, PUBLIC ObjectEntity REAL(4)
+ !DEF: /m/op3 POINTER, PUBLIC (InDataStmt) ObjectEntity REAL(4)
  !DEF: /m/x PUBLIC, TARGET ObjectEntity REAL(4)
  real, pointer :: op3 => x
- !DEF: /m/op4 POINTER, PUBLIC ObjectEntity REAL(4)
+ !DEF: /m/op4 POINTER, PUBLIC (InDataStmt) ObjectEntity REAL(4)
  !DEF: /m/y PUBLIC, TARGET ObjectEntity REAL(4)
  real, pointer :: op4 => y(1)
  !REF: /m/iface
  !DEF: /m/pp1 EXTERNAL, POINTER, PUBLIC (Subroutine) ProcEntity
  procedure(iface), pointer :: pp1
  !REF: /m/iface
  !DEF: /m/pp2 EXTERNAL, POINTER, PUBLIC (Subroutine) ProcEntity
  !REF: /m/null

  procedure(iface), pointer :: pp6 => modproc1
  !DEF: /m/t1 PUBLIC DerivedType
  type :: t1
   !DEF: /m/t1/opc1 POINTER ObjectEntity REAL(4)
   real, pointer :: opc1
   !DEF: /m/t1/opc2 POINTER ObjectEntity REAL(4)
   !REF: /m/null
   real, pointer :: opc2 => null()
-  !DEF: /m/t1/opc3 POINTER ObjectEntity REAL(4)
+  !DEF: /m/t1/opc3 POINTER (InDataStmt) ObjectEntity REAL(4)
   !REF: /m/x
   real, pointer :: opc3 => x
-  !DEF: /m/t1/opc4 POINTER ObjectEntity REAL(4)
+  !DEF: /m/t1/opc4 POINTER (InDataStmt) ObjectEntity REAL(4)
   !REF: /m/y
   real, pointer :: opc4 => y(1)
   !REF: /m/iface
   !DEF: /m/t1/ppc1 NOPASS, POINTER (Subroutine) ProcEntity
   procedure(iface), nopass, pointer :: ppc1
   !REF: /m/iface
   !DEF: /m/t1/ppc2 NOPASS, POINTER (Subroutine) ProcEntity
   !REF: /m/null

  type :: pdt1(k)
   !REF: /m/pdt1/k
   integer, kind :: k
   !DEF: /m/pdt1/opc1 POINTER ObjectEntity REAL(4)
   real, pointer :: opc1
   !DEF: /m/pdt1/opc2 POINTER ObjectEntity REAL(4)
   !REF: /m/null
   real, pointer :: opc2 => null()
-  !DEF: /m/pdt1/opc3 POINTER ObjectEntity REAL(4)
+  !DEF: /m/pdt1/opc3 POINTER (InDataStmt) ObjectEntity REAL(4)
   !REF: /m/x
   real, pointer :: opc3 => x
-  !DEF: /m/pdt1/opc4 POINTER ObjectEntity REAL(4)
+  !DEF: /m/pdt1/opc4 POINTER (InDataStmt) ObjectEntity REAL(4)
   !REF: /m/y
   !REF: /m/pdt1/k
   real, pointer :: opc4 => y(k)
   !REF: /m/iface
   !DEF: /m/pdt1/ppc1 NOPASS, POINTER (Subroutine) ProcEntity
   procedure(iface), nopass, pointer :: ppc1
   !REF: /m/iface
   !DEF: /m/pdt1/ppc2 NOPASS, POINTER (Subroutine) ProcEntity

  !REF: /m/iface
  !REF: /m/ext3
  procedure(iface) :: ext3
  interface
   !REF: /m/ext2
   subroutine ext2
   end subroutine
  end interface
- !DEF: /m/op10 POINTER, PUBLIC ObjectEntity REAL(4)
+ !DEF: /m/op10 POINTER, PUBLIC(InDataStmt) ObjectEntity REAL(4)
  !REF: /m/x
  real, pointer :: op10 => x
- !DEF: /m/op11 POINTER, PUBLIC ObjectEntity REAL(4)
+ !DEF: /m/op11 POINTER, PUBLIC(InDataStmt) ObjectEntity REAL(4)
  !REF: /m/y
  real, pointer :: op11 => y(1)
  !REF: /m/iface
  !DEF: /m/pp10 EXTERNAL, POINTER, PUBLIC (Subroutine) ProcEntity
  !REF: /m/ext1
  procedure(iface), pointer :: pp10 => ext1
  !REF: /m/iface
  !DEF: /m/pp11 EXTERNAL, POINTER, PUBLIC (Subroutine) ProcEntity
  !REF: /m/ext2
  procedure(iface), pointer :: pp11 => ext2
  !DEF: /m/t2 PUBLIC DerivedType
  type :: t2
-  !DEF: /m/t2/opc10 POINTER ObjectEntity REAL(4)
+  !DEF: /m/t2/opc10 POINTER (InDataStmt) ObjectEntity REAL(4)
   !REF: /m/x
   real, pointer :: opc10 => x
-  !DEF: /m/t2/opc11 POINTER ObjectEntity REAL(4)
+  !DEF: /m/t2/opc11 POINTER (InDataStmt) ObjectEntity REAL(4)
   !REF: /m/y
   real, pointer :: opc11 => y(1)
   !REF: /m/iface
   !DEF: /m/t2/ppc10 NOPASS, POINTER (Subroutine) ProcEntity
   !REF: /m/ext1
   procedure(iface), nopass, pointer :: ppc10 => ext1
   !REF: /m/iface
   !DEF: /m/t2/ppc11 NOPASS, POINTER (Subroutine) ProcEntity
   !REF: /m/ext2
   procedure(iface), nopass, pointer :: ppc11 => ext2
  contains
   !DEF: /m/t2/b10 NOPASS ProcBinding
   !REF: /m/ext2
   procedure, nopass :: b10 => ext2
   !DEF: /m/t2/b11 NOPASS ProcBinding
   !REF: /m/ext3
   procedure, nopass :: b11 => ext3
  end type
  !DEF: /m/pdt2 PUBLIC DerivedType
  !DEF: /m/pdt2/k TypeParam INTEGER(4)
  type :: pdt2(k)
   !REF: /m/pdt2/k
   integer, kind :: k
-  !DEF: /m/pdt2/opc10 POINTER ObjectEntity REAL(4)
+  !DEF: /m/pdt2/opc10 POINTER (InDataStmt) ObjectEntity REAL(4)
   !REF: /m/x
   real, pointer :: opc10 => x
-  !DEF: /m/pdt2/opc11 POINTER ObjectEntity REAL(4)
+  !DEF: /m/pdt2/opc11 POINTER (InDataStmt) ObjectEntity REAL(4)
   !REF: /m/y
   !REF: /m/pdt2/k
   real, pointer :: opc11 => y(k)
   !REF: /m/iface
   !DEF: /m/pdt2/ppc10 NOPASS, POINTER (Subroutine) ProcEntity
   !REF: /m/ext1
   procedure(iface), nopass, pointer :: ppc10 => ext1
   !REF: /m/iface