[flang] complete transfer of struct constructor code to expression.cc

Original-commit: flang-compiler/f18@e6178b2fc73bf7c98bb0519be8866ba799c17029
Reviewed-on: https://github.com/flang-compiler/f18/pull/287
Tree-same-pre-rewrite: false

diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index 2bfd9e4..d5b149a 100644 (file)
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -1340,6 +1340,15 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context,
   CHECK(spec.scope() != nullptr);
   const Symbol &typeSymbol{spec.typeSymbol()};
 
+  if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) {  // C796
+    if (auto *msg{context.Say(typeName,
+            "ABSTRACT derived type '%s' cannot be used in a structure constructor"_err_en_US,
+            typeName.ToString().data())}) {
+      msg->Attach(
+          typeSymbol.name(), "Declaration of ABSTRACT derived type"_en_US);
+    }
+  }
+
   // This list holds all of the components in the derived type and its
   // parents.  The symbols for whole parent components appear after their
   // own components and before the components of the types that extend them.
@@ -1350,14 +1359,7 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context,
   // initialize X or A by name, but not both.
   const auto &details{typeSymbol.get<semantics::DerivedTypeDetails>()};
   std::list<const Symbol *> components{details.OrderComponents(*spec.scope())};
-  if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) {  // C796
-    if (auto *msg{context.Say(typeName,
-            "ABSTRACT derived type '%s' cannot be used in a structure constructor"_err_en_US,
-            typeName.ToString().data())}) {
-      msg->Attach(
-          typeSymbol.name(), "Declaration of ABSTRACT derived type"_en_US);
-    }
-  }
+  auto nextAnonymous{components.begin()};
 
   std::set<parser::CharBlock> unavailable;
   bool anyKeyword{false};
@@ -1369,52 +1371,62 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context,
     const parser::Expr &expr{
         *std::get<parser::ComponentDataSource>(component.t).v};
     parser::CharBlock source{expr.source};
+    const Symbol *symbol{nullptr};
     if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
       source = kw->v.source;
+      symbol = kw->v.symbol;
       anyKeyword = true;
-    } else if (anyKeyword) {  // C7100
-      context.Say(source,
-          "Value in structure constructor lacks a component name"_err_en_US);
-      checkConflicts = false;  // stem cascade
-    }
-    if (component.symbol == nullptr) {
-      context.Say(
-          source, "INTERNAL: StructureConstructor lacks symbol"_err_en_US);
-      continue;
-    }
-    const Symbol &symbol{*component.symbol};
-    if (symbol.has<semantics::TypeParamDetails>()) {
-      context.Say(source,
-          "Type parameter '%s' cannot be a component of this structure constructor"_err_en_US,
-          symbol.name().ToString().data());
-    } else if (checkConflicts) {
-      auto componentIter{
-          std::find(components.begin(), components.end(), &symbol)};
-      if (unavailable.find(symbol.name()) != unavailable.cend()) {
-        // C797, C798
+    } else {
+      if (anyKeyword) {  // C7100
         context.Say(source,
-            "Component '%s' conflicts with another component earlier in this structure constructor"_err_en_US,
-            symbol.name().ToString().data());
-      } else if (symbol.test(Symbol::Flag::ParentComp)) {
-        // Make earlier components unavailable once a whole parent appears.
-        for (auto it{components.begin()}; it != componentIter; ++it) {
-          unavailable.insert((*it)->name());
+            "Value in structure constructor lacks a component name"_err_en_US);
+        checkConflicts = false;  // stem cascade
+      }
+      while (nextAnonymous != components.end()) {
+        symbol = *nextAnonymous++;
+        if (!symbol->test(Symbol::Flag::ParentComp)) {
+          break;
         }
-      } else {
-        // Make whole parent components unavailable after any of their
-        // constituents appear.
-        for (auto it{componentIter}; it != components.end(); ++it) {
-          if ((*it)->test(Symbol::Flag::ParentComp)) {
+      }
+      if (symbol == nullptr) {
+        context.Say(
+            source, "Unexpected value in structure constructor"_err_en_US);
+      }
+    }
+    if (symbol != nullptr) {
+      if (symbol->has<semantics::TypeParamDetails>()) {
+        context.Say(source,
+            "Type parameter '%s' cannot be a component of this structure constructor"_err_en_US,
+            symbol->name().ToString().data());
+      } else if (checkConflicts) {
+        auto componentIter{
+            std::find(components.begin(), components.end(), symbol)};
+        if (unavailable.find(symbol->name()) != unavailable.cend()) {
+          // C797, C798
+          context.Say(source,
+              "Component '%s' conflicts with another component earlier in this structure constructor"_err_en_US,
+              symbol->name().ToString().data());
+        } else if (symbol->test(Symbol::Flag::ParentComp)) {
+          // Make earlier components unavailable once a whole parent appears.
+          for (auto it{components.begin()}; it != componentIter; ++it) {
             unavailable.insert((*it)->name());
           }
+        } else {
+          // Make whole parent components unavailable after any of their
+          // constituents appear.
+          for (auto it{componentIter}; it != components.end(); ++it) {
+            if ((*it)->test(Symbol::Flag::ParentComp)) {
+              unavailable.insert((*it)->name());
+            }
+          }
         }
       }
-    }
-    unavailable.insert(symbol.name());
-    if (MaybeExpr value{AnalyzeExpr(context, expr)}) {
-      // TODO pmk: C7104, C7105 check that pointer components are
-      // being initialized with data/procedure designators appropriately
-      result.Add(symbol, std::move(*value));
+      unavailable.insert(symbol->name());
+      if (MaybeExpr value{AnalyzeExpr(context, expr)}) {
+        // TODO pmk: C7104, C7105 check that pointer components are
+        // being initialized with data/procedure designators appropriately
+        result.Add(*symbol, std::move(*value));
+      }
     }
   }
 

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index a5d0b06..05b87ec 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -3109,72 +3109,30 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
   EndDeclTypeSpec();
   SetDeclTypeSpecState(savedState);
 
-  auto &typeName{std::get<parser::Name>(parsedType.t)};
-  const DerivedTypeSpec *spec{type ? type->AsDerived() : nullptr};
-  const Symbol *typeSymbol{spec ? &spec->typeSymbol() : nullptr};
+  if (type == nullptr) {
+    return false;
+  }
+  const DerivedTypeSpec *spec{type->AsDerived()};
   const Scope *typeScope{spec ? spec->scope() : nullptr};
-
-  // This list holds all of the components in the derived type and its
-  // parents.  The symbols for whole parent components appear after their
-  // own components and before the components of the types that extend them.
-  // E.g., TYPE :: A; REAL X; END TYPE
-  //       TYPE, EXTENDS(A) :: B; REAL Y; END TYPE
-  // produces the component list X, A, Y.
-  // The order is important below because a structure constructor can
-  // initialize X or A by name, but not both.
-  SymbolList components;
-  bool ok{typeSymbol != nullptr && typeScope != nullptr};
-  if (ok) {
-    components =
-        typeSymbol->get<DerivedTypeDetails>().OrderComponents(*typeScope);
-    if (typeSymbol->attrs().test(Attr::ABSTRACT)) {  // C796
-      SayWithDecl(typeName, *typeSymbol,
-          "ABSTRACT type cannot be used in a structure constructor"_err_en_US);
-    }
+  if (typeScope == nullptr) {
+    return false;
   }
 
   // N.B C7102 is implicitly enforced by having inaccessible types not
   // being found in resolution.
 
-  auto nextAnonymous{components.begin()};
   for (const auto &component :
       std::get<std::list<parser::ComponentSpec>>(x.t)) {
     // Visit the component spec expression, but not the keyword, since
     // we need to resolve its symbol in the scope of the derived type.
-    const parser::Expr &value{
-        *std::get<parser::ComponentDataSource>(component.t).v};
-    Walk(value);
-    const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)};
-    const Symbol *symbol{nullptr};
-    SourceName source{value.source};
-    if (kw.has_value()) {
-      source = kw->v.source;
-      if (ok) {
-        symbol = FindInTypeOrParents(*typeScope, kw->v);
-        if (symbol == nullptr) {  // C7101
-          Say(source,
-              "Keyword '%s' is not a component of this derived type"_err_en_US);
-          ok = false;
-        }
+    Walk(std::get<parser::ComponentDataSource>(component.t));
+    if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
+      if (const Symbol * symbol{FindInTypeOrParents(*typeScope, kw->v)}) {
+        CheckAccessibleComponent(kw->v.source, *symbol);  // C7102
+      } else {  // C7101
+        Say(kw->v.source,
+            "Keyword '%s' is not a component of this derived type"_err_en_US);
       }
-    } else if (ok) {
-      while (nextAnonymous != components.end()) {
-        symbol = *nextAnonymous++;
-        if (symbol->test(Symbol::Flag::ParentComp)) {
-          symbol = nullptr;
-        } else {
-          break;
-        }
-      }
-      if (symbol == nullptr) {
-        Say(source, "Unexpected value in structure constructor"_err_en_US);
-        break;
-      }
-    }
-    if (symbol != nullptr) {
-      // Save the resolved component's symbol (if any) in the parse tree.
-      component.symbol = symbol;
-      CheckAccessibleComponent(source, *symbol);  // C7102
     }
   }
   return false;

diff --git a/flang/test/semantics/structconst01.f90 b/flang/test/semantics/structconst01.f90
index c070fee..8020254 100644 (file)
--- a/flang/test/semantics/structconst01.f90
+++ b/flang/test/semantics/structconst01.f90
@@ -57,6 +57,8 @@ module module1
     call type1arg(type1(0)(n=1,2))
     !ERROR: Component 'n' conflicts with another component earlier in this structure constructor
     call type1arg(type1(0)(n=1,n=2))
+    !ERROR: Unexpected value in structure constructor
+    call type1arg(type1(0)(1,2))
     call type2arg(type2(0,0)(n=1,m=2))
     call type2arg(type2(0,0)(m=2))
     !ERROR: Structure constructor lacks a value for component 'm'
@@ -73,5 +75,7 @@ module module1
     call type2arg(type2(0,0)(j=1, &
     !ERROR: Type parameter 'k' cannot be a component of this structure constructor
       k=2,m=3))
+    !ERROR: ABSTRACT derived type 'abstract' cannot be used in a structure constructor
+    call abstractarg(abstract(0)(n=1))
   end subroutine errors
 end module module1