From 13e0ce27ee8f79b89acbdd13f1bc0b7313444c5a Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Tue, 7 Oct 2025 12:21:04 -0700 Subject: [PATCH] [flang] Rework component KIND= values in PDT instantiations When processing the KIND= values of type specifications in parameterized derived type component declarations, it turns out to be necessary to analyze their expressions' parse trees rather than to just fold their typed expression representations. The types of the subexpressions may depend on the values of KIND parameters. Further, when checking the values of KIND= actual arguments to type conversion intrinsic functions (e.g., INT(..., KIND=)) that appear in KIND specifiers for PDT component declarations, don't emit an error for the derived type definition, but instead emit them for derived type instantiations. Fixes https://github.com/llvm/llvm-project/issues/161961. --- flang/include/flang/Evaluate/common.h | 18 +++++++- flang/include/flang/Semantics/expression.h | 1 + flang/include/flang/Semantics/symbol.h | 7 +++ flang/lib/Evaluate/intrinsics.cpp | 15 ++++-- flang/lib/Semantics/resolve-names.cpp | 46 ++++++++++++++++--- flang/lib/Semantics/symbol.cpp | 5 ++ flang/lib/Semantics/type.cpp | 42 ++++++++++++++--- flang/test/Semantics/kinds03.f90 | 8 ++-- flang/test/Semantics/pdt05.f90 | 24 ++++++++++ flang/test/Semantics/real10-x86-01.f90 | 4 +- flang/test/Semantics/symbol17.f90 | 30 ++++++------ .../Semantics/type-parameter-constant.f90 | 4 +- 12 files changed, 163 insertions(+), 41 deletions(-) create mode 100644 flang/test/Semantics/pdt05.f90 diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h index fb800c6ceb686..0263f15d4215e 100644 --- a/flang/include/flang/Evaluate/common.h +++ b/flang/include/flang/Evaluate/common.h @@ -231,14 +231,20 @@ class FoldingContext { : messages_{that.messages_}, defaults_{that.defaults_}, intrinsics_{that.intrinsics_}, targetCharacteristics_{that.targetCharacteristics_}, - pdtInstance_{that.pdtInstance_}, impliedDos_{that.impliedDos_}, + pdtInstance_{that.pdtInstance_}, + analyzingPDTComponentKindSelector_{ + that.analyzingPDTComponentKindSelector_}, + impliedDos_{that.impliedDos_}, languageFeatures_{that.languageFeatures_}, tempNames_{that.tempNames_} { } FoldingContext( const FoldingContext &that, const parser::ContextualMessages &m) : messages_{m}, defaults_{that.defaults_}, intrinsics_{that.intrinsics_}, targetCharacteristics_{that.targetCharacteristics_}, - pdtInstance_{that.pdtInstance_}, impliedDos_{that.impliedDos_}, + pdtInstance_{that.pdtInstance_}, + analyzingPDTComponentKindSelector_{ + that.analyzingPDTComponentKindSelector_}, + impliedDos_{that.impliedDos_}, languageFeatures_{that.languageFeatures_}, tempNames_{that.tempNames_} { } @@ -248,6 +254,9 @@ class FoldingContext { return defaults_; } const semantics::DerivedTypeSpec *pdtInstance() const { return pdtInstance_; } + bool analyzingPDTComponentKindSelector() const { + return analyzingPDTComponentKindSelector_; + } const IntrinsicProcTable &intrinsics() const { return intrinsics_; } const TargetCharacteristics &targetCharacteristics() const { return targetCharacteristics_; @@ -290,6 +299,10 @@ class FoldingContext { return common::ScopedSet(pdtInstance_, nullptr); } + common::Restorer AnalyzingPDTComponentKindSelector() { + return common::ScopedSet(analyzingPDTComponentKindSelector_, true); + } + parser::CharBlock SaveTempName(std::string &&name) { return {*tempNames_.emplace(std::move(name)).first}; } @@ -300,6 +313,7 @@ class FoldingContext { const IntrinsicProcTable &intrinsics_; const TargetCharacteristics &targetCharacteristics_; const semantics::DerivedTypeSpec *pdtInstance_{nullptr}; + bool analyzingPDTComponentKindSelector_{false}; std::optional moduleFileName_; std::map impliedDos_; const common::LanguageFeatureControl &languageFeatures_; diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h index 30f5dfd8a44cd..95c97f264a667 100644 --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -535,6 +535,7 @@ class ExprChecker { return true; } void Post(const parser::ComponentDefStmt &) { inComponentDefStmt_ = false; } + bool Pre(const parser::KindSelector &) { return !inComponentDefStmt_; } bool Pre(const parser::Initialization &x) { // Default component initialization expressions (but not DATA-like ones // as in DEC STRUCTUREs) were already analyzed in name resolution diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index 975423b32da73..18109dd6450f6 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -510,6 +510,11 @@ class DerivedTypeDetails { const std::list &componentNames() const { return componentNames_; } + const std::map & + originalKindParameterMap() const { + return originalKindParameterMap_; + } + void add_originalKindParameter(SourceName, const parser::Expr *); // If this derived type extends another, locate the parent component's symbol. const Symbol *GetParentComponent(const Scope &) const; @@ -538,6 +543,8 @@ class DerivedTypeDetails { bool sequence_{false}; bool isDECStructure_{false}; bool isForwardReferenced_{false}; + std::map originalKindParameterMap_; + friend llvm::raw_ostream &operator<<( llvm::raw_ostream &, const DerivedTypeDetails &); }; diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index fe679da4ff98b..f204eef54ef84 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2515,7 +2515,8 @@ std::optional IntrinsicInterface::Match( CHECK(kindDummyArg); CHECK(result.categorySet == CategorySet{*category}); if (kindArg) { - if (auto *expr{kindArg->UnwrapExpr()}) { + auto *expr{kindArg->UnwrapExpr()}; + if (expr) { CHECK(expr->Rank() == 0); if (auto code{ToInt64(Fold(context, common::Clone(*expr)))}) { if (context.targetCharacteristics().IsTypeEnabled( @@ -2529,8 +2530,16 @@ std::optional IntrinsicInterface::Match( } } } - messages.Say( - "'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type"_err_en_US); + if (context.analyzingPDTComponentKindSelector() && expr && + IsConstantExpr(*expr)) { + // Don't emit an error about a KIND= actual argument value when + // processing a kind selector in a PDT component declaration before + // it is instantianted, so long as it's a constant expression. + // It will be renanalyzed later during instantiation. + } else { + messages.Say( + "'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type"_err_en_US); + } // use default kind below for error recovery } else if (kindDummyArg->flags.test(ArgFlag::defaultsToSameKind)) { CHECK(sameArg); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index b7c7603d667d8..0da3133102914 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -357,6 +357,7 @@ class DeclTypeSpecVisitor : public AttrsVisitor { DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived}; } derived; bool allowForwardReferenceToDerivedType{false}; + const parser::Expr *originalKindParameter{nullptr}; }; bool allowForwardReferenceToDerivedType() const { @@ -365,8 +366,10 @@ class DeclTypeSpecVisitor : public AttrsVisitor { void set_allowForwardReferenceToDerivedType(bool yes) { state_.allowForwardReferenceToDerivedType = yes; } + void set_inPDTDefinition(bool yes) { inPDTDefinition_ = yes; } - const DeclTypeSpec *GetDeclTypeSpec(); + const DeclTypeSpec *GetDeclTypeSpec() const; + const parser::Expr *GetOriginalKindParameter() const; void BeginDeclTypeSpec(); void EndDeclTypeSpec(); void SetDeclTypeSpec(const DeclTypeSpec &); @@ -380,6 +383,7 @@ class DeclTypeSpecVisitor : public AttrsVisitor { private: State state_; + bool inPDTDefinition_{false}; void MakeNumericType(TypeCategory, int kind); }; @@ -2454,9 +2458,12 @@ bool AttrsVisitor::Pre(const common::CUDADataAttr x) { // DeclTypeSpecVisitor implementation -const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() { +const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() const { return state_.declTypeSpec; } +const parser::Expr *DeclTypeSpecVisitor::GetOriginalKindParameter() const { + return state_.originalKindParameter; +} void DeclTypeSpecVisitor::BeginDeclTypeSpec() { CHECK(!state_.expectDeclTypeSpec); @@ -2541,6 +2548,21 @@ void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) { KindExpr DeclTypeSpecVisitor::GetKindParamExpr( TypeCategory category, const std::optional &kind) { + if (inPDTDefinition_) { + if (category != TypeCategory::Derived && kind) { + if (const auto *expr{ + std::get_if(&kind->u)}) { + CHECK(!state_.originalKindParameter); + // Save a pointer to the KIND= expression in the parse tree + // in case we need to reanalyze it during PDT instantiation. + state_.originalKindParameter = &expr->thing.thing.thing.value(); + } + } + // Inhibit some errors now that will be caught later during instantiations. + auto restorer{ + context().foldingContext().AnalyzingPDTComponentKindSelector()}; + return AnalyzeKindSelector(context(), category, kind); + } return AnalyzeKindSelector(context(), category, kind); } @@ -6410,6 +6432,7 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) { details.set_isForwardReferenced(false); derivedTypeInfo_ = {}; PopScope(); + set_inPDTDefinition(false); return false; } @@ -6437,6 +6460,10 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { // component without producing spurious errors about already // existing. const Symbol &extendsSymbol{extendsType->typeSymbol()}; + if (extendsSymbol.scope() && + extendsSymbol.scope()->IsParameterizedDerivedType()) { + set_inPDTDefinition(true); + } auto restorer{common::ScopedSet(extendsName->symbol, nullptr)}; if (OkToAddComponent(*extendsName, &extendsSymbol)) { auto &comp{DeclareEntity(*extendsName, Attrs{})}; @@ -6455,8 +6482,12 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { } // Create symbols now for type parameters so that they shadow names // from the enclosing specification part. + const auto ¶mNames{std::get>(x.t)}; + if (!paramNames.empty()) { + set_inPDTDefinition(true); + } if (auto *details{symbol.detailsIf()}) { - for (const auto &name : std::get>(x.t)) { + for (const auto &name : paramNames) { if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{})}) { details->add_paramNameOrder(*symbol); } @@ -6544,8 +6575,7 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) { if (const auto *derived{declType->AsDerived()}) { if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C744 - Say("Recursive use of the derived type requires " - "POINTER or ALLOCATABLE"_err_en_US); + Say("Recursive use of the derived type requires POINTER or ALLOCATABLE"_err_en_US); } } } @@ -6558,7 +6588,11 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) { Initialization(name, *init, /*inComponentDecl=*/true); } } - currScope().symbol()->get().add_component(symbol); + auto &details{currScope().symbol()->get()}; + details.add_component(symbol); + if (const parser::Expr *kindExpr{GetOriginalKindParameter()}) { + details.add_originalKindParameter(name.source, kindExpr); + } } ClearArraySpec(); ClearCoarraySpec(); diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp index 6152f61fafd7f..69169469fe8ce 100644 --- a/flang/lib/Semantics/symbol.cpp +++ b/flang/lib/Semantics/symbol.cpp @@ -769,6 +769,11 @@ void DerivedTypeDetails::add_component(const Symbol &symbol) { componentNames_.push_back(symbol.name()); } +void DerivedTypeDetails::add_originalKindParameter( + SourceName name, const parser::Expr *expr) { + originalKindParameterMap_.emplace(name, expr); +} + const Symbol *DerivedTypeDetails::GetParentComponent(const Scope &scope) const { if (auto extends{GetParentComponentName()}) { if (auto iter{scope.find(*extends)}; iter != scope.cend()) { diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index 69e6ffa47d09e..dba15e6b91654 100644 --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -443,9 +443,9 @@ void InstantiateHelper::InstantiateComponents(const Scope &fromScope) { // Walks a parsed expression to prepare it for (re)analysis; // clears out the typedExpr analysis results and re-resolves // symbol table pointers of type parameters. -class ComponentInitResetHelper { +class ResetHelper { public: - explicit ComponentInitResetHelper(Scope &scope) : scope_{scope} {} + explicit ResetHelper(Scope &scope) : scope_{scope} {} template bool Pre(const A &) { return true; } @@ -498,7 +498,7 @@ void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) { } if (const auto *parsedExpr{details->unanalyzedPDTComponentInit()}) { // Analyze the parsed expression in this PDT instantiation context. - ComponentInitResetHelper resetter{scope_}; + ResetHelper resetter{scope_}; parser::Walk(*parsedExpr, resetter); auto restorer{foldingContext().messages().SetLocation(newSymbol.name())}; details->set_init(evaluate::Fold( @@ -564,16 +564,44 @@ static ParamValue FoldCharacterLength(evaluate::FoldingContext &foldingContext, // Apply type parameter values to an intrinsic type spec. const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType( SourceName symbolName, const DeclTypeSpec &spec) { + const parser::Expr *originalKindExpr{nullptr}; + if (const DerivedTypeSpec *derived{scope_.derivedTypeSpec()}) { + if (const auto *details{derived->originalTypeSymbol() + .GetUltimate() + .detailsIf()}) { + const auto &originalKindMap{details->originalKindParameterMap()}; + if (auto iter{originalKindMap.find(symbolName)}; + iter != originalKindMap.end()) { + originalKindExpr = iter->second; + } + } + } const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())}; - if (spec.category() != DeclTypeSpec::Character && + if (spec.category() != DeclTypeSpec::Character && !originalKindExpr && evaluate::IsActuallyConstant(intrinsic.kind())) { return spec; // KIND is already a known constant } // The expression was not originally constant, but now it must be so // in the context of a parameterized derived type instantiation. - KindExpr copy{Fold(common::Clone(intrinsic.kind()))}; + std::optional kindExpr; + if (originalKindExpr) { + ResetHelper resetter{scope_}; + parser::Walk(*originalKindExpr, resetter); + auto restorer{foldingContext().messages().DiscardMessages()}; + if (MaybeExpr analyzed{AnalyzeExpr(scope_.context(), *originalKindExpr)}) { + if (auto *intExpr{evaluate::UnwrapExpr(*analyzed)}) { + kindExpr = evaluate::ConvertToType( + std::move(*intExpr)); + } + } + } + if (!kindExpr) { + kindExpr = KindExpr{intrinsic.kind()}; + CHECK(kindExpr.has_value()); + } + KindExpr folded{Fold(std::move(*kindExpr))}; int kind{context().GetDefaultKind(intrinsic.category())}; - if (auto value{evaluate::ToInt64(copy)}) { + if (auto value{evaluate::ToInt64(folded)}) { if (foldingContext().targetCharacteristics().IsTypeEnabled( intrinsic.category(), *value)) { kind = *value; @@ -586,7 +614,7 @@ const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType( } else { std::string exprString; llvm::raw_string_ostream sstream(exprString); - copy.AsFortran(sstream); + folded.AsFortran(sstream); foldingContext().messages().Say(symbolName, "KIND parameter expression (%s) of intrinsic type %s did not resolve to a constant value"_err_en_US, exprString, diff --git a/flang/test/Semantics/kinds03.f90 b/flang/test/Semantics/kinds03.f90 index a15a4a9baa731..ed915bd14954d 100644 --- a/flang/test/Semantics/kinds03.f90 +++ b/flang/test/Semantics/kinds03.f90 @@ -5,7 +5,7 @@ type :: ipdt(k) !REF: /MainProgram1/ipdt/k integer, kind :: k - !REF: /MainProgram1/ipdt/k + !DEF: /MainProgram1/DerivedType9/k TypeParam INTEGER(4) !DEF: /MainProgram1/ipdt/x ObjectEntity INTEGER(int(int(k,kind=4),kind=8)) integer(kind=k) :: x end type ipdt @@ -14,7 +14,7 @@ type :: rpdt(k) !REF: /MainProgram1/rpdt/k integer, kind :: k - !REF: /MainProgram1/rpdt/k + !DEF: /MainProgram1/DerivedType13/k TypeParam INTEGER(4) !DEF: /MainProgram1/rpdt/x ObjectEntity REAL(int(int(k,kind=4),kind=8)) real(kind=k) :: x end type rpdt @@ -23,7 +23,7 @@ type :: zpdt(k) !REF: /MainProgram1/zpdt/k integer, kind :: k - !REF: /MainProgram1/zpdt/k + !DEF: /MainProgram1/DerivedType17/k TypeParam INTEGER(4) !DEF: /MainProgram1/zpdt/x ObjectEntity COMPLEX(int(int(k,kind=4),kind=8)) complex(kind=k) :: x end type zpdt @@ -32,7 +32,7 @@ type :: lpdt(k) !REF: /MainProgram1/lpdt/k integer, kind :: k - !REF: /MainProgram1/lpdt/k + !DEF: /MainProgram1/DerivedType21/k TypeParam INTEGER(4) !DEF: /MainProgram1/lpdt/x ObjectEntity LOGICAL(int(int(k,kind=4),kind=8)) logical(kind=k) :: x end type lpdt diff --git a/flang/test/Semantics/pdt05.f90 b/flang/test/Semantics/pdt05.f90 new file mode 100644 index 0000000000000..ec6b171702798 --- /dev/null +++ b/flang/test/Semantics/pdt05.f90 @@ -0,0 +1,24 @@ +!RUN: %flang_fc1 -fdebug-unparse %s | FileCheck %s + +module pdt05 + type base(k1,k2) + integer(1),kind :: k1 + integer(k1),kind :: k2 + integer(kind(int(k1,1)+int(k2,k1))) j + integer(kind(int(k1,1)+int(k2,kind(k2)))) k + end type +end + +use pdt05 +type(base(2,7)) x27 +type(base(8,7)) x87 +print *, 'x27%j', kind(x27%j) +print *, 'x27%k', kind(x27%k) +print *, 'x87%j', kind(x87%j) +print *, 'x87%k', kind(x87%k) +end + +!CHECK: PRINT *, "x27%j", 2_4 +!CHECK: PRINT *, "x27%k", 2_4 +!CHECK: PRINT *, "x87%j", 8_4 +!CHECK: PRINT *, "x87%k", 8_4 diff --git a/flang/test/Semantics/real10-x86-01.f90 b/flang/test/Semantics/real10-x86-01.f90 index ccaf34d8332a1..4215de3a8a9ee 100644 --- a/flang/test/Semantics/real10-x86-01.f90 +++ b/flang/test/Semantics/real10-x86-01.f90 @@ -6,7 +6,7 @@ type :: rpdt(k) !REF: /MainProgram1/rpdt/k integer, kind :: k - !REF: /MainProgram1/rpdt/k + !DEF: /MainProgram1/DerivedType3/k TypeParam INTEGER(4) !DEF: /MainProgram1/rpdt/x ObjectEntity REAL(int(int(k,kind=4),kind=8)) real(kind=k) :: x end type rpdt @@ -15,7 +15,7 @@ type :: zpdt(k) !REF: /MainProgram1/zpdt/k integer, kind :: k - !REF: /MainProgram1/zpdt/k + !DEF: /MainProgram1/DerivedType4/k TypeParam INTEGER(4) !DEF: /MainProgram1/zpdt/x ObjectEntity COMPLEX(int(int(k,kind=4),kind=8)) complex(kind=k) :: x end type zpdt diff --git a/flang/test/Semantics/symbol17.f90 b/flang/test/Semantics/symbol17.f90 index a0d916e55cfa4..f5f722290c901 100644 --- a/flang/test/Semantics/symbol17.f90 +++ b/flang/test/Semantics/symbol17.f90 @@ -79,7 +79,7 @@ type(fwdpdt(kind(0))) function f2(n) type :: fwdpdt(k) !REF: /f2/fwdpdt/k integer, kind :: k - !REF: /f2/fwdpdt/k + !DEF: /f2/DerivedType2/k TypeParam INTEGER(4) !DEF: /f2/fwdpdt/n ObjectEntity INTEGER(int(int(k,kind=4),kind=8)) integer(kind=k) :: n end type @@ -99,7 +99,7 @@ subroutine s2 (q1) type :: fwdpdt(k) !REF: /s2/fwdpdt/k integer, kind :: k - !REF: /s2/fwdpdt/k + !DEF: /s2/DerivedType2/k TypeParam INTEGER(4) !DEF: /s2/fwdpdt/n ObjectEntity INTEGER(int(int(k,kind=4),kind=8)) integer(kind=k) :: n end type @@ -110,31 +110,31 @@ subroutine s2 (q1) !DEF: /m1 Module module m1 !DEF: /m1/forward PRIVATE DerivedType - private :: forward + private :: forward !DEF: /m1/base PUBLIC DerivedType - type :: base + type :: base !REF: /m1/forward !DEF: /m1/base/p POINTER ObjectEntity CLASS(forward) - class(forward), pointer :: p - end type + class(forward), pointer :: p + end type !REF: /m1/base !REF: /m1/forward - type, extends(base) :: forward + type, extends(base) :: forward !DEF: /m1/forward/n ObjectEntity INTEGER(4) - integer :: n - end type - contains + integer :: n + end type +contains !DEF: /m1/test PUBLIC (Subroutine) Subprogram - subroutine test + subroutine test !REF: /m1/forward !DEF: /m1/test/object TARGET ObjectEntity TYPE(forward) - type(forward), target :: object + type(forward), target :: object !REF: /m1/test/object !REF: /m1/base/p - object%p => object + object%p => object !REF: /m1/test/object !REF: /m1/base/p !REF: /m1/forward/n - object%p%n = 666 - end subroutine + object%p%n = 666 + end subroutine end module diff --git a/flang/test/Semantics/type-parameter-constant.f90 b/flang/test/Semantics/type-parameter-constant.f90 index 376bffd0233ff..681012c094e9f 100644 --- a/flang/test/Semantics/type-parameter-constant.f90 +++ b/flang/test/Semantics/type-parameter-constant.f90 @@ -10,6 +10,6 @@ !ERROR: Value of KIND type parameter 'r' must be constant !WARNING: specification expression refers to local object 'six' (initialized and saved) [-Wsaved-local-in-spec-expr] !WARNING: specification expression refers to local object 'twenty_three' (initialized and saved) [-Wsaved-local-in-spec-expr] - type(a(six, twenty_three)) :: a2 + type(a(six, twenty_three)) :: a2 print *, a1%data%kind -end \ No newline at end of file +end