[flang-commits] [flang] 8989268 - [flang] Allow KIND type parameters to be used as LEN parameters of components
Peter Steinfeld via flang-commits
flang-commits at lists.llvm.org
Fri Apr 30 09:20:16 PDT 2021
Author: Peter Steinfeld
Date: 2021-04-30T09:05:05-07:00
New Revision: 8989268dae30d38bd6799038e14e6e33ee5528ad
URL: https://github.com/llvm/llvm-project/commit/8989268dae30d38bd6799038e14e6e33ee5528ad
DIFF: https://github.com/llvm/llvm-project/commit/8989268dae30d38bd6799038e14e6e33ee5528ad.diff
LOG: [flang] Allow KIND type parameters to be used as LEN parameters of components
When producing the runtime type information for a component of a derived type
that had a LEN type parameter, we were not allowing a KIND parameter of the
derived type. This was causing one of the NAG correctness tests to fail
(.../hibiya/d5.f90).
I added a test to our own test suite to check for this.
Also, I fixed a typo in .../module/__fortran_type_info.f90.
I allowed KIND type parameters to be used for the declarations of components
that use LEN parameters by constant folding the value of the LEN parameter. To
make the constant folding work, I had to put the semantics::DerivedTypeSpec of
the associated derived type into the folding context. To get this
semantics::DerivedTypeSpec, I changed the value of the semantics::Scope object
that was passed to DescribeComponent() to be the derived type scope rather than
the containing non-derived type scope.
This scope change, in turn, caused differences in the symbol table output that
is checked in typeinfo01.f90. Most of these differences were in the order that
the symbols appeared in the dump. But one of them changed one of the values
from "CHARACTER(2_8,1)" to "CHARACTER(1_8,1)". I'm not sure if these changes
are significant. Please verify that the results of this test are still valid.
Also, I wonder if there are other situations in this code where we should be
folding constants. For example, what if the field of a component has a
component whose type is a PDT with a LEN type parameter, and the component's
declaration depends on the KIND type parameter of the current PDT. Here's an
example:
type string(stringkind)
integer,kind :: stringkind
character(stringkind) :: value
end type string
type outer(kindparam)
integer,kind :: kindparam
type(string(kindparam)) :: field
end type outer
I don't understand the code or what it's trying to accomplish well enough to
figure out if such cases are correctly handled by my new code.
Differential Revision: https://reviews.llvm.org/D101482
Added:
Modified:
flang/lib/Semantics/runtime-type-info.cpp
flang/module/__fortran_type_info.f90
flang/test/Semantics/resolve69.f90
flang/test/Semantics/typeinfo01.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 2e4870a11dc08..9aea0e1faacc0 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -100,7 +100,8 @@ class RuntimeTableBuilder {
}
}
context_.Say(location_,
- "Specification expression '%s' is neither constant nor a length type parameter"_err_en_US,
+ "Specification expression '%s' is neither constant nor a length "
+ "type parameter"_err_en_US,
expr->AsFortran());
}
return PackageIntValue(deferredEnum_);
@@ -439,12 +440,12 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
},
[&](const ObjectEntityDetails &object) {
dataComponents.emplace_back(DescribeComponent(
- symbol, object, scope, distinctName, parameters));
+ symbol, object, dtScope, distinctName, parameters));
},
[&](const ProcEntityDetails &proc) {
if (IsProcedurePointer(symbol)) {
procPtrComponents.emplace_back(
- DescribeComponent(symbol, proc, scope));
+ DescribeComponent(symbol, proc, dtScope));
}
},
[&](const ProcBindingDetails &) { // handled in a later pass
@@ -607,8 +608,9 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope,
const std::string &distinctName, const SymbolVector *parameters) {
evaluate::StructureConstructorValues values;
+ auto &foldingContext{context_.foldingContext()};
auto typeAndShape{evaluate::characteristics::TypeAndShape::Characterize(
- symbol, context_.foldingContext())};
+ symbol, foldingContext)};
CHECK(typeAndShape.has_value());
auto dyType{typeAndShape->type()};
const auto &shape{typeAndShape->shape()};
@@ -624,7 +626,11 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
}
AddValue(values, componentSchema_, "offset"s, IntExpr<8>(symbol.offset()));
// CHARACTER length
- const auto &len{typeAndShape->LEN()};
+ auto len{typeAndShape->LEN()};
+ if (const semantics::DerivedTypeSpec * pdtInstance{scope.derivedTypeSpec()}) {
+ auto restorer{foldingContext.WithPDTInstance(*pdtInstance)};
+ len = Fold(foldingContext, std::move(len));
+ }
if (dyType.category() == TypeCategory::Character && len) {
AddValue(values, componentSchema_, "characterlen"s,
evaluate::AsGenericExpr(GetValue(len, parameters)));
@@ -682,7 +688,6 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
if (rank > 0 && !IsAllocatable(symbol) && !IsPointer(symbol)) {
std::vector<evaluate::StructureConstructor> bounds;
evaluate::NamedEntity entity{symbol};
- auto &foldingContext{context_.foldingContext()};
for (int j{0}; j < rank; ++j) {
bounds.emplace_back(GetValue(std::make_optional(evaluate::GetLowerBound(
foldingContext, entity, j)),
diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90
index 6a2b9dcf25b4c..eaa82e0cb5c38 100644
--- a/flang/module/__fortran_type_info.f90
+++ b/flang/module/__fortran_type_info.f90
@@ -53,7 +53,7 @@
character(len=:), pointer :: name
end type
- ! Array bounds and type parameters of ocmponents are deferred
+ ! Array bounds and type parameters of components are deferred
! (for allocatables and pointers), explicit constants, or
! taken from LEN type parameters for automatic components.
enum, bind(c) ! Value::Genre
diff --git a/flang/test/Semantics/resolve69.f90 b/flang/test/Semantics/resolve69.f90
index 515d8602fda9c..ecf1077ee01f2 100644
--- a/flang/test/Semantics/resolve69.f90
+++ b/flang/test/Semantics/resolve69.f90
@@ -33,6 +33,8 @@ subroutine s1()
type derived(typeKind, typeLen)
integer, kind :: typeKind
integer, len :: typeLen
+ character(typeKind) :: kindValue
+ character(typeLen) :: lenValue
end type derived
type (derived(constVal, 3)) :: constDerivedKind
@@ -53,3 +55,12 @@ subroutine s1()
type (derived( :, :)), pointer :: colonDerivedLen2
type (derived(4, :)), pointer :: colonDerivedLen3
end subroutine s1
+Program d5
+ Type string(maxlen)
+ Integer,Kind :: maxlen
+ Character(maxlen) :: value
+ End Type
+ Type(string(80)) line
+ line%value = 'ok'
+ Print *,Trim(line%value)
+End Program
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index 740c1bd47be28..cb568fcf6a099 100644
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -7,8 +7,8 @@ module m01
end type
!CHECK: .c.t1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.n,genre=1_1,category=0_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.t1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=4_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL())
-!CHECK: .n.n, SAVE, TARGET: ObjectEntity type: CHARACTER(2_8,1) init:"n"
!CHECK: .n.t1, SAVE, TARGET: ObjectEntity type: CHARACTER(2_8,1) init:"t1"
+!CHECK: .n.n, SAVE, TARGET: ObjectEntity type: CHARACTER(1_8,1) init:"n"
end module
module m02
@@ -229,10 +229,10 @@ module m11
!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.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=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]
+!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])
type(t(*)), intent(in) :: x
end subroutine
end module
More information about the flang-commits
mailing list