Index: flang/include/flang/Evaluate/tools.h =================================================================== --- flang/include/flang/Evaluate/tools.h +++ flang/include/flang/Evaluate/tools.h @@ -1144,6 +1144,8 @@ // but identical derived types. bool AreTkCompatibleTypes(const DeclTypeSpec *x, const DeclTypeSpec *y); +bool HasConstantKindAndLen(const Symbol &); + } // namespace Fortran::semantics #endif // FORTRAN_EVALUATE_TOOLS_H_ Index: flang/lib/Evaluate/tools.cpp =================================================================== --- flang/lib/Evaluate/tools.cpp +++ flang/lib/Evaluate/tools.cpp @@ -1558,4 +1558,22 @@ return false; } +bool HasConstantKindAndLen(const Symbol &sym) { + if (const DeclTypeSpec * type{sym.GetType()}) { + if (type->category() == DeclTypeSpec::Numeric) { + return evaluate::IsActuallyConstant(type->numericTypeSpec().kind()); + } else if (type->category() == DeclTypeSpec::Logical) { + return evaluate::IsActuallyConstant(type->logicalTypeSpec().kind()); + } else if (type->category() == DeclTypeSpec::Character) { + if (evaluate::IsActuallyConstant(type->characterTypeSpec().kind())) { + if (const auto &length{ + type->characterTypeSpec().length().GetExplicit()}) { + return evaluate::IsActuallyConstant(*length); + } + } + } + } + return false; +} + } // namespace Fortran::semantics Index: flang/lib/Semantics/resolve-names.cpp =================================================================== --- flang/lib/Semantics/resolve-names.cpp +++ flang/lib/Semantics/resolve-names.cpp @@ -6689,7 +6689,58 @@ } else if (auto *details{ultimate.detailsIf()}) { CHECK(!details->init()); Walk(expr); - if (ultimate.owner().IsParameterizedDerivedType()) { + bool hasTypeParamInInit{false}; + if (const Symbol * owner{ultimate.owner().symbol()}) { + if (const auto *dtDetails{owner->detailsIf()}) { + for (std::size_t i{0}; i < dtDetails->paramDecls().size(); ++i) { + std::string exprStr = expr.thing.value().source.ToString(); + std::string paramStr = + dtDetails->paramDecls()[i].get().name().ToString(); + // Check if the constant expression has type parameters. Be aware + // of the kind/len intrinsics such as the expression of + // "int(kind(0), kind(kind))", in which only the last "kind" is + // the type parameter. + if (exprStr.size() < paramStr.size()) { + continue; + } + for (std::size_t j{0}; j <= exprStr.size() - paramStr.size(); + j = j + paramStr.size()) { + if (exprStr.find(paramStr, j) != std::string::npos && + (exprStr.find(paramStr, j) + paramStr.size() >= + exprStr.size() || + exprStr.at(exprStr.find(paramStr, j) + + paramStr.size()) != '(')) { + hasTypeParamInInit = true; + break; + } + } + // Check if the shape has the type parameters. The constant + // expression such as "kind(kind)" has been folded before. + for (const auto &elem : details->shape()) { + if (elem.lbound().isExplicit()) { + if (paramStr.compare( + (*elem.lbound().GetExplicit()).AsFortran()) == 0) { + hasTypeParamInInit = true; + break; + } + } + if (elem.ubound().isExplicit()) { + if (paramStr.compare( + (*elem.ubound().GetExplicit()).AsFortran()) == 0) { + hasTypeParamInInit = true; + break; + } + } + } + if (hasTypeParamInInit) { + break; + } + } + } + } + if (ultimate.owner().IsParameterizedDerivedType() && + (!semantics::HasConstantKindAndLen(*name.symbol) || + hasTypeParamInInit)) { // Save the expression for per-instantiation analysis. details->set_unanalyzedPDTComponentInit(&expr.thing.value()); } else { Index: flang/test/Semantics/init01.f90 =================================================================== --- flang/test/Semantics/init01.f90 +++ flang/test/Semantics/init01.f90 @@ -59,7 +59,6 @@ type :: t2(kind, len) integer, kind :: kind integer, len :: len -!ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3 !ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3 real :: x1(2) = [1., 2., 3.] !ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3 Index: flang/test/Semantics/init02.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/init02.f90 @@ -0,0 +1,142 @@ +! RUN: %flang_fc1 -fdebug-dump-parse-tree %s 2>&1 | FileCheck %s --check-prefix=SEMA_ON +! RUN: %flang_fc1 -fdebug-dump-parse-tree-no-sema %s 2>&1 | FileCheck %s --check-prefix=SEMA_OFF + +!----------------- +! EXPECTEED OUTPUT +!----------------- + +!SEMA_ON: Name = 'a0' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr -> Designator -> DataRef -> Name = 'kind' +!SEMA_ON: Name = 'a1' +!SEMA_ON-NEXT: ComponentArraySpec -> ExplicitShapeSpec +!SEMA_ON-NEXT: | SpecificationExpr -> Scalar -> Integer -> Expr = '2_4' +!SEMA_ON-NEXT: | | LiteralConstant -> IntLiteralConstant = '2' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr -> FunctionReference -> Call +!SEMA_ON-NEXT: | ProcedureDesignator -> Name = 'int' +!SEMA_ON-NEXT: | ActualArgSpec +!SEMA_ON-NEXT: | | ActualArg -> Expr -> FunctionReference -> Call +!SEMA_ON-NEXT: | | | ProcedureDesignator -> Name = 'kind' +!SEMA_ON-NEXT: | | | ActualArgSpec +!SEMA_ON-NEXT: | | | | ActualArg -> Expr -> LiteralConstant -> IntLiteralConstant = '0' +!SEMA_ON-NEXT: | ActualArgSpec +!SEMA_ON-NEXT: | | ActualArg -> Expr -> FunctionReference -> Call +!SEMA_ON-NEXT: | | | ProcedureDesignator -> Name = 'kind' +!SEMA_ON-NEXT: | | | ActualArgSpec +!SEMA_ON-NEXT: | | | | ActualArg -> Expr -> Designator -> DataRef -> Name = 'kind' +!SEMA_ON: Name = 'a2' +!SEMA_ON-NEXT: ComponentArraySpec -> ExplicitShapeSpec +!SEMA_ON-NEXT: | SpecificationExpr -> Scalar -> Integer -> Expr = 'int(kind,kind=4)' +!SEMA_ON-NEXT: | | Designator -> DataRef -> Name = 'kind' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr -> ArrayConstructor -> AcSpec +!SEMA_ON-NEXT: | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '1' +!SEMA_ON-NEXT: | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '2' +!SEMA_ON: Name = 'a3' +!SEMA_ON-NEXT: ComponentArraySpec -> ExplicitShapeSpec +!SEMA_ON-NEXT: | SpecificationExpr -> Scalar -> Integer -> Expr = 'int(kind,kind=4)' +!SEMA_ON-NEXT: | | Designator -> DataRef -> Name = 'kind' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr -> Designator -> DataRef -> Name = 'l' +!SEMA_ON: Name = 'a4' +!SEMA_ON-NEXT: ComponentArraySpec -> ExplicitShapeSpec +!SEMA_ON-NEXT: | SpecificationExpr -> Scalar -> Integer -> Expr = '4_4' +!SEMA_ON-NEXT: | | FunctionReference -> Call +!SEMA_ON-NEXT: | | | ProcedureDesignator -> Name = 'kind' +!SEMA_ON-NEXT: | | | ActualArgSpec +!SEMA_ON-NEXT: | | | | ActualArg -> Expr = 'int(kind,kind=4)' +!SEMA_ON-NEXT: | | | | | Designator -> DataRef -> Name = 'kind' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr = '2_4' +!SEMA_ON-NEXT: | LiteralConstant -> IntLiteralConstant = '2' +!SEMA_ON: Name = 'x' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr = '10_4' +!SEMA_ON-NEXT: | LiteralConstant -> IntLiteralConstant = '10' +!SEMA_ON: Name = 'll' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr = '.true._4' +!SEMA_ON-NEXT: | LiteralConstant -> LogicalLiteralConstant +!SEMA_ON-NEXT: | | bool +!SEMA_ON: Name = 'r' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr = '1._4' +!SEMA_ON-NEXT: | LiteralConstant -> RealLiteralConstant +!SEMA_ON-NEXT: | | Real = '1.0' +!SEMA_ON: Name = 'c' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr = '(2._4,1._4)' +!SEMA_ON-NEXT: | LiteralConstant -> ComplexLiteralConstant +!SEMA_ON-NEXT: | | ComplexPart -> SignedRealLiteralConstant +!SEMA_ON-NEXT: | | | RealLiteralConstant +!SEMA_ON-NEXT: | | | | Real = '2.0' +!SEMA_ON-NEXT: | | ComplexPart -> SignedRealLiteralConstant +!SEMA_ON-NEXT: | | | RealLiteralConstant +!SEMA_ON-NEXT: | | | | Real = '1.0' +!SEMA_ON: Name = 's' +!SEMA_ON-NEXT: Initialization -> Constant -> Expr = '"s"' +!SEMA_ON-NEXT: | LiteralConstant -> CharLiteralConstant +!SEMA_ON-NEXT: | | string = 's' + +!SEMA_OFF: Name = 'a0' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> Designator -> DataRef -> Name = 'kind' +!SEMA_OFF: Name = 'a1' +!SEMA_OFF-NEXT: ComponentArraySpec -> ExplicitShapeSpec +!SEMA_OFF-NEXT: | SpecificationExpr -> Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '2' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> FunctionReference -> Call +!SEMA_OFF-NEXT: | ProcedureDesignator -> Name = 'int' +!SEMA_OFF-NEXT: | ActualArgSpec +!SEMA_OFF-NEXT: | | ActualArg -> Expr -> FunctionReference -> Call +!SEMA_OFF-NEXT: | | | ProcedureDesignator -> Name = 'kind' +!SEMA_OFF-NEXT: | | | ActualArgSpec +!SEMA_OFF-NEXT: | | | | ActualArg -> Expr -> LiteralConstant -> IntLiteralConstant = '0' +!SEMA_OFF-NEXT: | ActualArgSpec +!SEMA_OFF-NEXT: | | ActualArg -> Expr -> FunctionReference -> Call +!SEMA_OFF-NEXT: | | | ProcedureDesignator -> Name = 'kind' +!SEMA_OFF-NEXT: | | | ActualArgSpec +!SEMA_OFF-NEXT: | | | | ActualArg -> Expr -> Designator -> DataRef -> Name = 'kind' +!SEMA_OFF: Name = 'a2' +!SEMA_OFF-NEXT: ComponentArraySpec -> ExplicitShapeSpec +!SEMA_OFF-NEXT: | SpecificationExpr -> Scalar -> Integer -> Expr -> Designator -> DataRef -> Name = 'kind' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> ArrayConstructor -> AcSpec +!SEMA_OFF-NEXT: | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '1' +!SEMA_OFF-NEXT: | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '2' +!SEMA_OFF: Name = 'a3' +!SEMA_OFF-NEXT: ComponentArraySpec -> ExplicitShapeSpec +!SEMA_OFF-NEXT: | SpecificationExpr -> Scalar -> Integer -> Expr -> Designator -> DataRef -> Name = 'kind' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> Designator -> DataRef -> Name = 'l' +!SEMA_OFF: Name = 'a4' +!SEMA_OFF-NEXT: ComponentArraySpec -> ExplicitShapeSpec +!SEMA_OFF-NEXT: | SpecificationExpr -> Scalar -> Integer -> Expr -> FunctionReference -> Call +!SEMA_OFF-NEXT: | | ProcedureDesignator -> Name = 'kind' +!SEMA_OFF-NEXT: | | ActualArgSpec +!SEMA_OFF-NEXT: | | | ActualArg -> Expr -> Designator -> DataRef -> Name = 'kind' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> LiteralConstant -> IntLiteralConstant = '2' +!SEMA_OFF: Name = 'x' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> LiteralConstant -> IntLiteralConstant = '10' +!SEMA_OFF: Name = 'll' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> LiteralConstant -> LogicalLiteralConstant +!SEMA_OFF-NEXT: | bool +!SEMA_OFF: Name = 'r' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> LiteralConstant -> RealLiteralConstant +!SEMA_OFF-NEXT: | Real = '1.0' +!SEMA_OFF: Name = 'c' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> LiteralConstant -> ComplexLiteralConstant +!SEMA_OFF-NEXT: | ComplexPart -> SignedRealLiteralConstant +!SEMA_OFF-NEXT: | | RealLiteralConstant +!SEMA_OFF-NEXT: | | | Real = '2.0' +!SEMA_OFF-NEXT: | ComplexPart -> SignedRealLiteralConstant +!SEMA_OFF-NEXT: | | RealLiteralConstant +!SEMA_OFF-NEXT: | | | Real = '1.0' +!SEMA_OFF: Name = 's' +!SEMA_OFF-NEXT: Initialization -> Constant -> Expr -> LiteralConstant -> CharLiteralConstant +!SEMA_OFF-NEXT: | string = 's' + +subroutine sub() + type my_type (kind, l) + integer, KIND :: kind = 4 + integer, LEN :: l = 4 + integer :: a0 = kind + integer :: a1(2) = int(kind(0), kind(kind)) + integer :: a2(kind) = [1, 2] + integer :: a3(kind) = l + integer :: a4(kind(kind)) = 2 + integer :: x = 10 + logical :: ll = .true. + real :: r = 1.0 + complex :: c = (2.0, 1.0) + character :: s = "s" + end type +end