diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -382,6 +382,7 @@ template 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 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1463,7 +1463,16 @@ MaybeExpr ExpressionAnalyzer::Analyze( const parser::StructureConstructor &structure) { auto &parsedType{std::get(structure.t)}; - parser::CharBlock typeName{std::get(parsedType.t).source}; + parser::Name structureType{std::get(parsedType.t)}; + parser::CharBlock &typeName{structureType.source}; + if (semantics::Symbol * typeSymbol{structureType.symbol}) { + if (typeSymbol->has()) { + semantics::DerivedTypeSpec dtSpec{typeName, typeSymbol->GetUltimate()}; + if (!CheckIsValidForwardReference(dtSpec)) { + return std::nullopt; + } + } + } if (!parsedType.derivedTypeSpec) { return std::nullopt; } @@ -2182,6 +2191,17 @@ 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 *structureConstructor) { const parser::Call &call{funcRef.v}; @@ -2209,11 +2229,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 (!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 --- a/flang/test/Semantics/bad-forward-type.f90 +++ b/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