[PATCH] D101330: [flang] Handle structure constructors with forward references to PDTs

[Pete Steinfeld via Phabricator via llvm-commits]

PeteSteinfeld created this revision.
PeteSteinfeld added reviewers: tskeith, klausler.
PeteSteinfeld requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

We were not correctly handling structure constructors that had forward
references to parameterized derived types.  I harvested the code that checks
for forward references that was used during analysis of function call
expressions and called it from there and also called it during the
analysis of structure constructors.

I also added a test that will produce an internal error without this change.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D101330

Files:
  flang/include/flang/Semantics/expression.h
  flang/lib/Semantics/expression.cpp
  flang/test/Semantics/bad-forward-type.f90


Index: flang/test/Semantics/bad-forward-type.f90
===================================================================
--- flang/test/Semantics/bad-forward-type.f90
+++ flang/test/Semantics/bad-forward-type.f90
@@ -79,3 +79,14 @@
     real :: c
   end type
 end subroutine
+
+subroutine s9
+  type con
+    Type(t(3)), pointer :: y
+  end type
+  !ERROR: Cannot construct value for derived type 't' before it is defined
+  Integer :: nn = Size(Transfer(t(3)(666),[0]))
+  type :: t(n)
+    integer, kind :: n = 3
+  end type
+end subroutine s9
Index: flang/lib/Semantics/expression.cpp
===================================================================
--- flang/lib/Semantics/expression.cpp
+++ flang/lib/Semantics/expression.cpp
@@ -1463,8 +1463,16 @@
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::StructureConstructor &structure) {
   auto &parsedType{std::get<parser::DerivedTypeSpec>(structure.t)};
-  parser::CharBlock typeName{std::get<parser::Name>(parsedType.t).source};
-  if (!parsedType.derivedTypeSpec) {
+  parser::Name structureType{std::get<parser::Name>(parsedType.t)};
+  parser::CharBlock &typeName{structureType.source};
+  if (semantics::Symbol * typeSymbol{structureType.symbol}) {
+    if (typeSymbol->has<semantics::DerivedTypeDetails>()) {
+      semantics::DerivedTypeSpec dtSpec{typeName, typeSymbol->GetUltimate()};
+      if (IsBadForwardReference(dtSpec)) {
+        return std::nullopt;
+      }
+    }
+  } else if (!parsedType.derivedTypeSpec) {
     return std::nullopt;
   }
   const auto &spec{*parsedType.derivedTypeSpec};
@@ -2182,6 +2190,17 @@
   return AssumedTypePointerOrAllocatableDummy(x);
 }
 
+bool ExpressionAnalyzer::IsBadForwardReference(
+    const semantics::DerivedTypeSpec &dtSpec) {
+  if (dtSpec.IsForwardReferenced()) {
+    Say("Cannot construct value for derived type '%s' "
+        "before it is defined"_err_en_US,
+        dtSpec.name());
+    return true;
+  }
+  return false;
+}
+
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
     std::optional<parser::StructureConstructor> *structureConstructor) {
   const parser::Call &call{funcRef.v};
@@ -2209,11 +2228,7 @@
         semantics::Scope &scope{context_.FindScope(name->source)};
         semantics::DerivedTypeSpec dtSpec{
             name->source, derivedType.GetUltimate()};
-        if (dtSpec.IsForwardReferenced()) {
-          Say(call.source,
-              "Cannot construct value for derived type '%s' "
-              "before it is defined"_err_en_US,
-              name->source);
+        if (IsBadForwardReference(dtSpec)) {
           return std::nullopt;
         }
         const semantics::DeclTypeSpec &type{
Index: flang/include/flang/Semantics/expression.h
===================================================================
--- flang/include/flang/Semantics/expression.h
+++ flang/include/flang/Semantics/expression.h
@@ -382,6 +382,7 @@
   template <typename T> T Fold(T &&expr) {
     return evaluate::Fold(foldingContext_, std::move(expr));
   }
+  bool IsBadForwardReference(const semantics::DerivedTypeSpec &);
 
   semantics::SemanticsContext &context_;
   FoldingContext &foldingContext_{context_.foldingContext()};


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D101330.340672.patch
Type: text/x-patch
Size: 3210 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210426/aca2c71a/attachment.bin>