[flang-commits] [flang] c9da9c0 - [flang] Support PDT KIND parameters in later parameter kind expressions
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Aug 29 13:53:13 PDT 2023
Author: Peter Klausler
Date: 2023-08-29T13:51:34-07:00
New Revision: c9da9c0d74ec5f5cf92be73783a00f7139dfc070
URL: https://github.com/llvm/llvm-project/commit/c9da9c0d74ec5f5cf92be73783a00f7139dfc070
DIFF: https://github.com/llvm/llvm-project/commit/c9da9c0d74ec5f5cf92be73783a00f7139dfc070.diff
LOG: [flang] Support PDT KIND parameters in later parameter kind expressions
Fortran allows an earlier-declared KIND type parameter of a parameterized
derived type to be used in the constant expression defining the integer
kind of a later type parameter.
TYPE :: T(K,L)
INTEGER, KIND :: K
INTEGER(K), LEN :: L
...
END TYPE
Differential Revision: https://reviews.llvm.org/D159044https://reviews.llvm.org/D159044
Added:
flang/test/Semantics/label18.f90#
flang/test/Semantics/pdt02.f90
Modified:
flang/lib/Evaluate/fold-implementation.h
flang/lib/Evaluate/fold-integer.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/runtime-type-info.cpp
flang/lib/Semantics/type.cpp
flang/test/Semantics/resolve105.f90
flang/test/Semantics/resolve69.f90
flang/test/Semantics/selecttype01.f90
flang/test/Semantics/typeinfo01.f90
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index c47a22c99a4577..2a40018cd5a386 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1132,12 +1132,17 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
ActualArguments &args{funcRef.arguments()};
- for (std::optional<ActualArgument> &arg : args) {
- if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) {
- *expr = Fold(context, std::move(*expr));
+ const auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
+ if (!intrinsic || intrinsic->name != "kind") {
+ // Don't fold the argument to KIND(); it might be a TypeParamInquiry
+ // with a forced result type that doesn't match the parameter.
+ for (std::optional<ActualArgument> &arg : args) {
+ if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) {
+ *expr = Fold(context, std::move(*expr));
+ }
}
}
- if (auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)}) {
+ if (intrinsic) {
const std::string name{intrinsic->name};
if (name == "cshift") {
return Folder<T>{context}.CSHIFT(std::move(funcRef));
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 2c67880771c624..27770ba5de8889 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -844,10 +844,23 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else if (name == "int_ptr_kind") {
return Expr<T>{8};
} else if (name == "kind") {
- if constexpr (common::HasMember<T, IntegerTypes>) {
- return Expr<T>{args[0].value().GetType()->kind()};
- } else {
- DIE("kind() result not integral");
+ // FoldOperation(FunctionRef &&) in fold-implementation.h will not
+ // have folded the argument; in the case of TypeParamInquiry,
+ // try to get the type of the parameter itself.
+ if (const auto *expr{args[0] ? args[0]->UnwrapExpr() : nullptr}) {
+ std::optional<DynamicType> dyType;
+ if (const auto *inquiry{UnwrapExpr<TypeParamInquiry>(*expr)}) {
+ if (const auto *typeSpec{inquiry->parameter().GetType()}) {
+ if (const auto *intrinType{typeSpec->AsIntrinsic()}) {
+ if (auto k{ToInt64(Fold(
+ context, Expr<SubscriptInteger>{intrinType->kind()}))}) {
+ return Expr<T>{*k};
+ }
+ }
+ }
+ } else if (auto dyType{expr->GetType()}) {
+ return Expr<T>{dyType->kind()};
+ }
}
} else if (name == "iparity") {
return FoldBitReduction(
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 3321ed57a6af87..7d9b3188a60996 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -924,10 +924,30 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
} else {
const Symbol &ultimate{n.symbol->GetUltimate()};
if (ultimate.has<semantics::TypeParamDetails>()) {
- // A bare reference to a derived type parameter (within a parameterized
- // derived type definition)
+ // A bare reference to a derived type parameter within a parameterized
+ // derived type definition.
+ auto dyType{DynamicType::From(ultimate)};
+ if (!dyType) {
+ // When the integer kind of this type parameter is not known now,
+ // it's either an error or because it depends on earlier-declared kind
+ // type parameters. So assume that it's a subscript integer for now
+ // while processing other specification expressions in the PDT
+ // definition; the right kind value will be used later in each of its
+ // instantiations.
+ int kind{SubscriptInteger::kind};
+ if (const auto *typeSpec{ultimate.GetType()}) {
+ if (const semantics::IntrinsicTypeSpec *
+ intrinType{typeSpec->AsIntrinsic()}) {
+ if (auto k{ToInt64(Fold(semantics::KindExpr{intrinType->kind()}))};
+ k && IsValidKindOfIntrinsicType(TypeCategory::Integer, *k)) {
+ kind = *k;
+ }
+ }
+ }
+ dyType = DynamicType{TypeCategory::Integer, kind};
+ }
return Fold(ConvertToType(
- ultimate, AsGenericExpr(TypeParamInquiry{std::nullopt, ultimate})));
+ *dyType, AsGenericExpr(TypeParamInquiry{std::nullopt, ultimate})));
} else {
if (n.symbol->attrs().test(semantics::Attr::VOLATILE)) {
if (const semantics::Scope *pure{semantics::FindPureProcedureContaining(
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 2e95d4c70e77f3..c46b12d6b30e86 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -428,9 +428,12 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
(typeName.front() == '.' && !context_.IsTempName(typeName))) {
return nullptr;
}
+ bool isPDTDefinitionWithKindParameters{
+ !derivedTypeSpec && dtScope.IsDerivedTypeWithKindParameter()};
+ bool isPDTInstantiation{derivedTypeSpec && &dtScope != dtSymbol->scope()};
const SymbolVector *parameters{GetTypeParameters(*dtSymbol)};
std::string distinctName{typeName};
- if (&dtScope != dtSymbol->scope() && derivedTypeSpec) {
+ if (isPDTInstantiation) {
// Only create new type descriptions for
diff erent kind parameter values.
// Type with
diff erent length parameters/same kind parameters can all
// share the same type description available in the current scope.
@@ -438,6 +441,8 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
GetSuffixIfTypeKindParameters(*derivedTypeSpec, parameters)}) {
distinctName += *suffix;
}
+ } else if (isPDTDefinitionWithKindParameters) {
+ return nullptr;
}
std::string dtDescName{".dt."s + distinctName};
Scope *dtSymbolScope{const_cast<Scope *>(dtSymbol->scope())};
@@ -455,9 +460,7 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
evaluate::StructureConstructorValues dtValues;
AddValue(dtValues, derivedTypeSchema_, "name"s,
SaveNameAsPointerTarget(scope, typeName));
- bool isPDTdefinitionWithKindParameters{
- !derivedTypeSpec && dtScope.IsDerivedTypeWithKindParameter()};
- if (!isPDTdefinitionWithKindParameters) {
+ if (!isPDTDefinitionWithKindParameters) {
auto sizeInBytes{static_cast<common::ConstantSubscript>(dtScope.size())};
if (auto alignment{dtScope.alignment().value_or(0)}) {
sizeInBytes += alignment - 1;
@@ -467,10 +470,10 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
AddValue(
dtValues, derivedTypeSchema_, "sizeinbytes"s, IntToExpr(sizeInBytes));
}
- bool isPDTinstantiation{derivedTypeSpec && &dtScope != dtSymbol->scope()};
- if (isPDTinstantiation) {
- const Symbol *uninstDescObject{
- DescribeType(DEREF(const_cast<Scope *>(dtSymbol->scope())))};
+ if (const Symbol *
+ uninstDescObject{isPDTInstantiation
+ ? DescribeType(DEREF(const_cast<Scope *>(dtSymbol->scope())))
+ : nullptr}) {
AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
evaluate::Designator<evaluate::SomeDerived>{
@@ -489,22 +492,24 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
// by their instantiated (or default) values, while LEN= type
// parameters are described by their INTEGER kinds.
for (SymbolRef ref : *parameters) {
- const auto &tpd{ref->get<TypeParamDetails>()};
- if (tpd.attr() == common::TypeParamAttr::Kind) {
- auto value{evaluate::ToInt64(tpd.init()).value_or(0)};
- if (derivedTypeSpec) {
- if (const auto *pv{derivedTypeSpec->FindParameter(ref->name())}) {
- if (pv->GetExplicit()) {
- if (auto instantiatedValue{
- evaluate::ToInt64(*pv->GetExplicit())}) {
- value = *instantiatedValue;
+ if (const auto *inst{dtScope.FindComponent(ref->name())}) {
+ const auto &tpd{inst->get<TypeParamDetails>()};
+ if (tpd.attr() == common::TypeParamAttr::Kind) {
+ auto value{evaluate::ToInt64(tpd.init()).value_or(0)};
+ if (derivedTypeSpec) {
+ if (const auto *pv{derivedTypeSpec->FindParameter(inst->name())}) {
+ if (pv->GetExplicit()) {
+ if (auto instantiatedValue{
+ evaluate::ToInt64(*pv->GetExplicit())}) {
+ value = *instantiatedValue;
+ }
}
}
}
+ kinds.emplace_back(value);
+ } else { // LEN= parameter
+ lenKinds.emplace_back(GetIntegerKind(*inst));
}
- kinds.emplace_back(value);
- } else { // LEN= parameter
- lenKinds.emplace_back(GetIntegerKind(*ref));
}
}
}
@@ -515,7 +520,7 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
SaveNumericPointerTarget<Int1>(
scope, SaveObjectName(".lpk."s + distinctName), std::move(lenKinds)));
// Traverse the components of the derived type
- if (!isPDTdefinitionWithKindParameters) {
+ if (!isPDTDefinitionWithKindParameters) {
std::vector<const Symbol *> dataComponentSymbols;
std::vector<evaluate::StructureConstructor> procPtrComponents;
for (const auto &pair : dtScope) {
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index 1be59d75e1f097..a72c2e8ea23c61 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -110,58 +110,80 @@ void DerivedTypeSpec::EvaluateParameters(SemanticsContext &context) {
}
evaluated_ = true;
auto &messages{foldingContext.messages()};
-
- // Fold the explicit type parameter value expressions first. Do not
- // fold them within the scope of the derived type being instantiated;
- // these expressions cannot use its type parameters. Convert the values
- // of the expressions to the declared types of the type parameters.
- auto parameterDecls{OrderParameterDeclarations(typeSymbol_)};
- for (const Symbol &symbol : parameterDecls) {
- const SourceName &name{symbol.name()};
+ for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) {
+ SourceName name{symbol.name()};
+ int parameterKind{evaluate::TypeParamInquiry::Result::kind};
+ // Compute the integer kind value of the type parameter,
+ // which may depend on the values of earlier ones.
+ if (const auto *typeSpec{symbol.GetType()}) {
+ if (const IntrinsicTypeSpec * intrinType{typeSpec->AsIntrinsic()};
+ intrinType && intrinType->category() == TypeCategory::Integer) {
+ auto restorer{foldingContext.WithPDTInstance(*this)};
+ auto folded{Fold(foldingContext, KindExpr{intrinType->kind()})};
+ if (auto k{evaluate::ToInt64(folded)}; k &&
+ evaluate::IsValidKindOfIntrinsicType(TypeCategory::Integer, *k)) {
+ parameterKind = static_cast<int>(*k);
+ } else {
+ messages.Say(
+ "Type of type parameter '%s' (%s) is not a valid kind of INTEGER"_err_en_US,
+ name, intrinType->kind().AsFortran());
+ }
+ }
+ }
+ bool ok{
+ symbol.get<TypeParamDetails>().attr() == common::TypeParamAttr::Len};
if (ParamValue * paramValue{FindParameter(name)}) {
+ // Explicit type parameter value expressions are not folded within
+ // the scope of the derived type being instantiated, as the expressions
+ // themselves are not in that scope and cannot reference its type
+ // parameters.
if (const MaybeIntExpr & expr{paramValue->GetExplicit()}) {
- if (auto converted{evaluate::ConvertToType(symbol, SomeExpr{*expr})}) {
+ evaluate::DynamicType dyType{TypeCategory::Integer, parameterKind};
+ if (auto converted{evaluate::ConvertToType(dyType, SomeExpr{*expr})}) {
SomeExpr folded{
evaluate::Fold(foldingContext, std::move(*converted))};
if (auto *intExpr{std::get_if<SomeIntExpr>(&folded.u)}) {
+ ok = ok || evaluate::IsActuallyConstant(*intExpr);
paramValue->SetExplicit(std::move(*intExpr));
- continue;
}
- }
- if (!context.HasError(symbol)) {
+ } else if (!context.HasError(symbol)) {
evaluate::SayWithDeclaration(messages, symbol,
- "Value of type parameter '%s' (%s) is not convertible to its"
- " type"_err_en_US,
- name, expr->AsFortran());
+ "Value of type parameter '%s' (%s) is not convertible to its type (%s)"_err_en_US,
+ name, expr->AsFortran(), dyType.AsFortran());
}
}
- }
- }
-
- // Default initialization expressions for the derived type's parameters
- // may reference other parameters so long as the declaration precedes the
- // use in the expression (10.1.12). This is not necessarily the same
- // order as "type parameter order" (7.5.3.2).
- // Type parameter default value expressions are folded in declaration order
- // within the scope of the derived type so that the values of earlier type
- // parameters are available for use in the default initialization
- // expressions of later parameters.
- auto restorer{foldingContext.WithPDTInstance(*this)};
- for (const Symbol &symbol : parameterDecls) {
- const SourceName &name{symbol.name()};
- if (!FindParameter(name)) {
+ } else {
+ // Default type parameter value expressions are folded within
+ // the scope of the derived type being instantiated.
const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
if (details.init()) {
- auto expr{evaluate::Fold(foldingContext, SomeExpr{*details.init()})};
- AddParamValue(name,
- ParamValue{
- std::move(std::get<SomeIntExpr>(expr.u)), details.attr()});
+ evaluate::DynamicType dyType{TypeCategory::Integer, parameterKind};
+ if (auto converted{
+ evaluate::ConvertToType(dyType, SomeExpr{*details.init()})}) {
+ auto restorer{foldingContext.WithPDTInstance(*this)};
+ SomeExpr folded{
+ evaluate::Fold(foldingContext, std::move(*converted))};
+ ok = ok || evaluate::IsActuallyConstant(folded);
+ AddParamValue(name,
+ ParamValue{
+ std::move(std::get<SomeIntExpr>(folded.u)), details.attr()});
+ } else {
+ if (!context.HasError(symbol)) {
+ evaluate::SayWithDeclaration(messages, symbol,
+ "Default value of type parameter '%s' (%s) is not convertible to its type (%s)"_err_en_US,
+ name, details.init()->AsFortran(), dyType.AsFortran());
+ }
+ }
} else if (!context.HasError(symbol)) {
messages.Say(name_,
"Type parameter '%s' lacks a value and has no default"_err_en_US,
name);
}
}
+ if (!ok && !context.HasError(symbol)) {
+ messages.Say(
+ "Value of KIND type parameter '%s' must be constant"_err_en_US, name);
+ }
}
}
@@ -335,20 +357,23 @@ void DerivedTypeSpec::Instantiate(Scope &containingScope) {
if (ParamValue * paramValue{FindParameter(name)}) {
const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
paramValue->set_attr(details.attr());
- TypeParamDetails instanceDetails{details.attr()};
- if (const DeclTypeSpec * type{details.type()}) {
- instanceDetails.set_type(*type);
- }
desc += sep;
desc += name.ToString();
desc += '=';
sep = ',';
+ TypeParamDetails instanceDetails{details.attr()};
if (MaybeIntExpr expr{paramValue->GetExplicit()}) {
- if (auto folded{evaluate::NonPointerInitializationExpr(symbol,
- SomeExpr{std::move(*expr)}, foldingContext, &newScope)}) {
- desc += folded->AsFortran();
- instanceDetails.set_init(
- std::move(DEREF(evaluate::UnwrapExpr<SomeIntExpr>(*folded))));
+ desc += expr->AsFortran();
+ instanceDetails.set_init(
+ std::move(DEREF(evaluate::UnwrapExpr<SomeIntExpr>(*expr))));
+ if (auto dyType{expr->GetType()}) {
+ instanceDetails.set_type(newScope.MakeNumericType(
+ TypeCategory::Integer, KindExpr{dyType->kind()}));
+ }
+ }
+ if (!instanceDetails.type()) {
+ if (const DeclTypeSpec * type{details.type()}) {
+ instanceDetails.set_type(*type);
}
}
if (!instanceDetails.init()) {
diff --git a/flang/test/Semantics/label18.f90# b/flang/test/Semantics/label18.f90#
new file mode 100644
index 00000000000000..47b2a61dbc4b5d
--- /dev/null
+++ b/flang/test/Semantics/label18.f90#
@@ -0,0 +1,18 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+program main
+ if (.true.) then
+ do j = 1, 2
+ goto 1 ! ok; used to cause looping in label resolution
+ end do
+ else
+ goto 1 ! ok
+1 end if
+ if (.true.) then
+ do j = 1, 2
+ !WARNING: Label '1' is in a construct that should not be used as a branch target here
+ goto 1
+ end do
+ end if
+ !WARNING: Label '1' is in a construct that should not be used as a branch target here
+ goto 1
+end
diff --git a/flang/test/Semantics/pdt02.f90 b/flang/test/Semantics/pdt02.f90
new file mode 100644
index 00000000000000..a4a64f9d6ca08c
--- /dev/null
+++ b/flang/test/Semantics/pdt02.f90
@@ -0,0 +1,15 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+program p
+ type t(k,n)
+ integer, kind :: k
+ integer(k), len :: n
+!CHECK: warning: INTEGER(1) addition overflowed
+ integer :: c = n + 1_1
+ end type
+!CHECK: in the context: instantiation of parameterized derived type 't(k=1_4,n=127_1)'
+ print *, t(1,127)()
+end
+
+!CHECK: PRINT *, t(k=1_4,n=127_1)(c=-128_4)
+
+
diff --git a/flang/test/Semantics/resolve105.f90 b/flang/test/Semantics/resolve105.f90
index ab294d401349b8..13623207c0bf7f 100644
--- a/flang/test/Semantics/resolve105.f90
+++ b/flang/test/Semantics/resolve105.f90
@@ -43,6 +43,7 @@ subroutine testGoodDefault(arg)
end subroutine testGoodDefault
subroutine testStar(arg)
+ !ERROR: Value of KIND type parameter 'kindparam' must be constant
type(dtype(*)),intent(inout) :: arg
if (associated(arg%field)) stop 'fail'
end subroutine testStar
diff --git a/flang/test/Semantics/resolve69.f90 b/flang/test/Semantics/resolve69.f90
index e5bdac5205e2eb..e1f7773eee9da0 100644
--- a/flang/test/Semantics/resolve69.f90
+++ b/flang/test/Semantics/resolve69.f90
@@ -52,7 +52,7 @@ function foo3()
end type derived
type (derived(constVal, 3)) :: constDerivedKind
-!ERROR: Value of kind type parameter 'typekind' (nonconstval) must be a scalar INTEGER constant
+!ERROR: Value of KIND type parameter 'typekind' must be constant
!ERROR: Invalid specification expression: reference to local entity 'nonconstval'
type (derived(nonConstVal, 3)) :: nonConstDerivedKind
@@ -63,6 +63,7 @@ function foo3()
type (derived(3, nonConstVal)) :: nonConstDerivedLen
!ERROR: 'colonderivedlen' has a type derived(typekind=3_4,typelen=:) with a deferred type parameter but is neither an allocatable nor an object pointer
type (derived(3, :)) :: colonDerivedLen
+!ERROR: Value of KIND type parameter 'typekind' must be constant
!ERROR: 'colonderivedlen1' has a type derived(typekind=:,typelen=:) with a deferred type parameter but is neither an allocatable nor an object pointer
type (derived( :, :)) :: colonDerivedLen1
type (derived( :, :)), pointer :: colonDerivedLen2
diff --git a/flang/test/Semantics/selecttype01.f90 b/flang/test/Semantics/selecttype01.f90
index 4ac7fe6aafc461..e8699f20620cef 100644
--- a/flang/test/Semantics/selecttype01.f90
+++ b/flang/test/Semantics/selecttype01.f90
@@ -200,6 +200,7 @@ subroutine foo(x)
type is (pdt(kind=1, len=*))
!ERROR: Type specification 'pdt(kind=2_4,len=*)' must be an extension of TYPE 'pdt(kind=1_4,len=:)'
type is (pdt(kind=2, len=*))
+ !ERROR: Value of KIND type parameter 'kind' must be constant
!ERROR: Type specification 'pdt(kind=*,len=*)' must be an extension of TYPE 'pdt(kind=1_4,len=:)'
type is (pdt(kind=*, len=*))
end select
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index bc43bdbfc32fbe..0d381f10b04831 100644
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -34,9 +34,7 @@ module m03
end type
type(kpdt(4)) :: x
!CHECK: .c.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=1_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
-!CHECK: .dt.kpdt, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.kpdt,uninstantiated=NULL(),kindparameter=.kp.kpdt,lenparameterkind=NULL())
-!CHECK: .dt.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,uninstantiated=.dt.kpdt,kindparameter=.kp.kpdt.4,lenparameterkind=NULL(),component=.c.kpdt.4,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
-!CHECK: .kp.kpdt, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::1_8]
+!CHECK: .dt.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=.kp.kpdt.4,lenparameterkind=NULL(),component=.c.kpdt.4,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .kp.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::4_8]
end module
More information about the flang-commits
mailing list