[flang] Handle structure constructors with forward references to PDTs

[PeteSteinfeld]

Summary

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.

[klausler]

Looks great apart from my naming nit.

flang/include/flang/Semantics/expression.h

385

Since this member function can emit a Message, it's not just a predicate; a name with "Check" would be better.

flang/include/flang/Semantics/expression.h

private:
   bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,
       bool defaultKind = false);
   MaybeExpr MakeFunctionRef(
       parser::CharBlock, ProcedureDesignator &&, ActualArguments &&);
   MaybeExpr MakeFunctionRef(parser::CharBlock intrinsic, ActualArguments &&);
   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()};
   std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
   bool isWholeAssumedSizeArrayOk_{false};
   bool useSavedTypedExprs_{true};
   friend class ArgumentAnalyzer;
 };

flang/lib/Semantics/expression.cpp

for (const parser::AcValue &value : acSpec.values) {
     acContext.Add(value);
   }
   return acContext.ToExpr();
 }
 
 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;
   }
   const auto &spec{*parsedType.derivedTypeSpec};
   const Symbol &typeSymbol{spec.typeSymbol()};
   if (!spec.scope() || !typeSymbol.has<semantics::DerivedTypeDetails>()) {
     return std::nullopt; // error recovery
   }
const Symbol *AssumedTypeDummy<parser::AllocateObject>(
   return AssumedTypePointerOrAllocatableDummy(x);
 }
 template <>
 const Symbol *AssumedTypeDummy<parser::PointerObject>(
     const parser::PointerObject &x) {
   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};
   auto restorer{GetContextualMessages().SetLocation(call.source)};
   ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */};
   for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
     analyzer.Analyze(arg, false /* not subroutine call */);
   }
if (auto *proc{std::get_if<ProcedureDesignator>(&callee->u)}) {
       // Structure constructor misparsed as function reference?
       CHECK(std::holds_alternative<semantics::SymbolRef>(callee->u));
       const Symbol &derivedType{*std::get<semantics::SymbolRef>(callee->u)};
       const auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
       if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
         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{
             semantics::FindOrInstantiateDerivedType(scope, std::move(dtSpec))};
         auto &mutableRef{const_cast<parser::FunctionReference &>(funcRef)};
         *structureConstructor =
             mutableRef.ConvertToStructureConstructor(type.derivedTypeSpec());
         return Analyze(structureConstructor->value());

flang/test/Semantics/bad-forward-type.f90

 subroutine s8
   implicit type(t2)(x)
   !ERROR: Cannot construct value for derived type 't2' before it is defined
   parameter(y=t2(12.3))
   type t2
     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