diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -182,6 +182,52 @@ } } +// A variant of UnwrapExpr above that also skips through (parentheses) +// and conversions of kinds within a category. Useful for extracting LEN +// type parameter inquiries, at least. +template +auto UnwrapConvertedExpr(B &x) -> common::Constify * { + using Ty = std::decay_t; + if constexpr (std::is_same_v) { + return &x; + } else if constexpr (std::is_same_v) { + if (auto *expr{x.UnwrapExpr()}) { + return UnwrapConvertedExpr(*expr); + } + } else if constexpr (std::is_same_v>) { + return std::visit([](auto &x) { return UnwrapConvertedExpr(x); }, x.u); + } else if constexpr (!common::HasMember) { + using Result = ResultType; + if constexpr (std::is_same_v> || + std::is_same_v>>) { + return std::visit([](auto &x) { return UnwrapConvertedExpr(x); }, x.u); + } else if constexpr (std::is_same_v> || + std::is_same_v>) { + return std::visit( + [](auto &x) { return UnwrapConvertedExpr(x); }, x.left().u); + } + } + return nullptr; +} + +// When an expression is a "bare" LEN= derived type parameter inquiry, +// possibly wrapped in integer kind conversions &/or parentheses, return +// a pointer to the Symbol with TypeParamDetails. +template const Symbol *ExtractBareLenParameter(const A &expr) { + if (const auto *typeParam{ + evaluate::UnwrapConvertedExpr(expr)}) { + if (!typeParam->base()) { + const Symbol &symbol{typeParam->parameter()}; + if (const auto *tpd{symbol.detailsIf()}) { + if (tpd->attr() == common::TypeParamAttr::Len) { + return &symbol; + } + } + } + } + return nullptr; +} + // If an expression simply wraps a DataRef, extract and return it. // The Boolean argument controls the handling of Substring // references: when true (not default), it extracts the base DataRef diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -1177,14 +1177,23 @@ // Conversion of non-constant in same type category if constexpr (std::is_same_v) { return std::move(kindExpr); // remove needless conversion - } else if constexpr (std::is_same_v) { + } else if constexpr (TO::category == TypeCategory::Logical || + TO::category == TypeCategory::Integer) { if (auto *innerConv{ - std::get_if>( - &kindExpr.u)}) { + std::get_if>(&kindExpr.u)}) { + // Conversion of conversion of same category & kind if (auto *x{std::get_if>(&innerConv->left().u)}) { - if (std::holds_alternative(x->u)) { - // int(int(size(...),kind=k),kind=8) -> size(...) - return std::move(*x); + if constexpr (TO::category == TypeCategory::Logical || + TO::kind <= Operand::kind) { + return std::move(*x); // no-op Logical or Integer + // widening/narrowing conversion pair + } else if constexpr (std::is_same_v) { + if (std::holds_alternative(x->u) || + std::holds_alternative(x->u)) { + // int(int(size(...),kind=k),kind=8) -> size(...) + return std::move(*x); + } } } } diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -656,7 +656,9 @@ return Expr{std::move(funcRef)}; } -// Substitute a bare type parameter reference with its value if it has one now +// Substitutes a bare type parameter reference with its value if it has one now +// in an instantiation. Bare LEN type parameters are substituted only when +// the known value is constant. Expr FoldOperation( FoldingContext &context, TypeParamInquiry &&inquiry) { std::optional base{inquiry.base()}; @@ -678,16 +680,20 @@ } } } else { - // A "bare" type parameter: replace with its value, if that's now known. + // A "bare" type parameter: replace with its value, if that's now known + // in a current derived type instantiation, for KIND type parameters. if (const auto *pdt{context.pdtInstance()}) { + bool isLen{false}; if (const semantics::Scope * scope{context.pdtInstance()->scope()}) { auto iter{scope->find(parameterName)}; if (iter != scope->end()) { const Symbol &symbol{*iter->second}; const auto *details{symbol.detailsIf()}; if (details) { + isLen = details->attr() == common::TypeParamAttr::Len; const semantics::MaybeIntExpr &initExpr{details->init()}; - if (initExpr && IsConstantExpr(*initExpr)) { + if (initExpr && IsConstantExpr(*initExpr) && + (!isLen || ToInt64(*initExpr))) { Expr expr{*initExpr}; return Fold(context, ConvertToType(std::move(expr))); @@ -697,9 +703,12 @@ } if (const auto *value{pdt->FindParameter(parameterName)}) { if (value->isExplicit()) { - return Fold(context, + auto folded{Fold(context, AsExpr(ConvertToType( - Expr{value->GetExplicit().value()}))); + Expr{value->GetExplicit().value()})))}; + if (!isLen || ToInt64(folded)) { + return folded; + } } } } diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp --- a/flang/lib/Semantics/runtime-type-info.cpp +++ b/flang/lib/Semantics/runtime-type-info.cpp @@ -92,21 +92,13 @@ if (auto constValue{evaluate::ToInt64(expr)}) { return PackageIntValue(explicitEnum_, *constValue); } - if (parameters) { - if (const auto *typeParam{ - evaluate::UnwrapExpr(expr)}) { - if (!typeParam->base()) { - const Symbol &symbol{typeParam->parameter()}; - if (const auto *tpd{symbol.detailsIf()}) { - if (tpd->attr() == common::TypeParamAttr::Len) { - return PackageIntValue(lenParameterEnum_, - FindLenParameterIndex(*parameters, symbol)); - } - } + if (expr) { + if (parameters) { + if (const Symbol * lenParam{evaluate::ExtractBareLenParameter(*expr)}) { + return PackageIntValue( + lenParameterEnum_, FindLenParameterIndex(*parameters, *lenParam)); } } - } - if (expr) { context_.Say(location_, "Specification expression '%s' is neither constant nor a length type parameter"_err_en_US, expr->AsFortran()); @@ -687,7 +679,7 @@ // Shape information int rank{evaluate::GetRank(shape)}; AddValue(values, componentSchema_, "rank"s, IntExpr<1>(rank)); - if (rank > 0) { + if (rank > 0 && !IsAllocatable(symbol) && !IsPointer(symbol)) { std::vector bounds; evaluate::NamedEntity entity{symbol}; auto &foldingContext{context_.foldingContext()}; diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -212,7 +212,7 @@ evaluate::FoldingContext &foldingContext() { return context().foldingContext(); } - template T Fold(T &&expr) { + template A Fold(A &&expr) { return evaluate::Fold(foldingContext(), std::move(expr)); } void InstantiateComponent(const Symbol &); @@ -377,7 +377,7 @@ // in PARAMETER structure constructors. auto restorer{foldingContext().messages().SetLocation(newSymbol.name())}; init = IsPointer(newSymbol) - ? evaluate::Fold(foldingContext(), std::move(*init)) + ? Fold(std::move(*init)) : evaluate::NonPointerInitializationExpr( newSymbol, std::move(*init), foldingContext()); } diff --git a/flang/test/Semantics/modfile22.f90 b/flang/test/Semantics/modfile22.f90 --- a/flang/test/Semantics/modfile22.f90 +++ b/flang/test/Semantics/modfile22.f90 @@ -15,8 +15,8 @@ !module m !type::t(k) !integer(4),kind::k=1_4 -!character(1_4,int(int(k,kind=4),kind=8))::a -!character(3_4,int(int(k,kind=4),kind=8))::b +!character(1_4,k)::a +!character(3_4,k)::b !end type !type(t(k=1_4)),parameter::p=t(k=1_4)(a="x",b="xx ") !character(2_4,1),parameter::c2(1_8:3_8)=[CHARACTER(KIND=1,LEN=2)::"x ","xx","xx"] diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90 --- a/flang/test/Semantics/typeinfo01.f90 +++ b/flang/test/Semantics/typeinfo01.f90 @@ -229,9 +229,8 @@ !CHECK: .lpk.t, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1] contains subroutine s1(x) -!CHECK: .b.t.1.allocatable, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=1_1,value=0_8),value(genre=1_1,value=0_8)],shape=[2,1]) !CHECK: .b.t.1.automatic, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=2_1,value=1_8),value(genre=3_1,value=0_8)],shape=[2,1]) -!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.allocatable,initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL()),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=target)] +!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL()),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=target)] !CHECK: .dt.t.1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,parent=NULL(),uninstantiated=.dt.t,kindparameter=NULL(),lenparameterkind=.lpk.t.1,component=.c.t.1,procptr=NULL(),special=NULL()) !CHECK: .lpk.t.1, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1] type(t(*)), intent(in) :: x diff --git a/flang/tools/f18/f18.cpp b/flang/tools/f18/f18.cpp --- a/flang/tools/f18/f18.cpp +++ b/flang/tools/f18/f18.cpp @@ -256,6 +256,15 @@ Fortran::semantics::Semantics semantics{semanticsContext, parseTree, parsing.cooked().AsCharBlock(), driver.debugModuleWriter}; semantics.Perform(); + Fortran::semantics::RuntimeDerivedTypeTables tables; + if (!semantics.AnyFatalError()) { + tables = + Fortran::semantics::BuildRuntimeDerivedTypeTables(semanticsContext); + if (!tables.schemata) { + llvm::errs() << driver.prefix + << "could not find module file for __fortran_type_info\n"; + } + } semantics.EmitMessages(llvm::errs()); if (semantics.AnyFatalError()) { if (driver.dumpSymbols) { @@ -268,12 +277,6 @@ } return {}; } - auto tables{ - Fortran::semantics::BuildRuntimeDerivedTypeTables(semanticsContext)}; - if (!tables.schemata) { - llvm::errs() << driver.prefix - << "could not find module file for __fortran_type_info\n"; - } if (driver.dumpSymbols) { semantics.DumpSymbols(llvm::outs()); }