[flang-commits] [flang] 8b550af - [flang] Handle structure constructors with forward references to PDTs

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2021-04-27T12:46:05-07:00
New Revision: 8b550af7a9cf363d382b7042f12ab24aa13711fc

URL: https://github.com/llvm/llvm-project/commit/8b550af7a9cf363d382b7042f12ab24aa13711fc
DIFF: https://github.com/llvm/llvm-project/commit/8b550af7a9cf363d382b7042f12ab24aa13711fc.diff

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

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.

Differential Revision: https://reviews.llvm.org/D101330

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 2f89820f4b0b1..79c35b2d7b93e 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -382,6 +382,7 @@ class ExpressionAnalyzer {
   template <typename T> T Fold(T &&expr) {
     return evaluate::Fold(foldingContext_, std::move(expr));
   }
+  bool CheckIsValidForwardReference(const semantics::DerivedTypeSpec &);
 
   semantics::SemanticsContext &context_;
   FoldingContext &foldingContext_{context_.foldingContext()};

diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index b826221be6433..b67f52c41a3be 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1463,7 +1463,16 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
 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};
+  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 (!CheckIsValidForwardReference(dtSpec)) {
+        return std::nullopt;
+      }
+    }
+  }
   if (!parsedType.derivedTypeSpec) {
     return std::nullopt;
   }
@@ -2182,6 +2191,17 @@ const Symbol *AssumedTypeDummy<parser::PointerObject>(
   return AssumedTypePointerOrAllocatableDummy(x);
 }
 
+bool ExpressionAnalyzer::CheckIsValidForwardReference(
+    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 false;
+  }
+  return true;
+}
+
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
     std::optional<parser::StructureConstructor> *structureConstructor) {
   const parser::Call &call{funcRef.v};
@@ -2209,11 +2229,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
         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 (!CheckIsValidForwardReference(dtSpec)) {
           return std::nullopt;
         }
         const semantics::DeclTypeSpec &type{

diff  --git a/flang/test/Semantics/bad-forward-type.f90 b/flang/test/Semantics/bad-forward-type.f90
index 6c7d082d03ef5..9177a7c96d15a 100644
--- a/flang/test/Semantics/bad-forward-type.f90
+++ b/flang/test/Semantics/bad-forward-type.f90
@@ -79,3 +79,14 @@ subroutine s8
     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