[flang] Allow KIND type parameters to be used as LEN parameters of components

[PeteSteinfeld]

Summary

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.

[klausler]

flang/lib/Semantics/runtime-type-info.cpp

98

FindLenParameterIndex() isn't going to return a meaningful result for a KIND type parameter.

I think the solution to this bug may have to be found at a higher level. KIND type parameters should have been replaced with their constant values in each instantiation of a parameterized derived type. The runtime type information tables should be generated only for derived type instantiations. So a KIND type parameter shouldn't make it here in the first place.

[PeteSteinfeld]

Responding to Peter's comments. I totally changed my implementation to be as
described in the current commit description.

[klausler]

flang/lib/Semantics/runtime-type-info.cpp

103–104

KIND type parameters are necessarily constant in derived type instantiations so this message change may mislead a programmer into thinking that a specification expression in a component has to be a "bare" KIND type parameter and not a more general constant expression that can involve KIND type parameters.

[PeteSteinfeld]

flang/lib/Semantics/runtime-type-info.cpp

103–104

Good point. I'll revert this message to its previous value.

[PeteSteinfeld]

Responding to Peter's comments.

[PeteSteinfeld]

Responding to Peter's comments.

flang/lib/Semantics/runtime-type-info.cpp

evaluate::StructureConstructor GetValue(
       const std::optional<evaluate::Expr<T>> &expr,
       const SymbolVector *parameters) {
     if (auto constValue{evaluate::ToInt64(expr)}) {
       return PackageIntValue(explicitEnum_, *constValue);
     }
     if (expr) {
       if (parameters) {
         if (const Symbol * lenParam{evaluate::ExtractBareLenParameter(*expr)}) {
           return PackageIntValue(
               lenParameterEnum_, FindLenParameterIndex(*parameters, *lenParam));
         }
       }
       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_);
   }
 
   SemanticsContext &context_;
   RuntimeDerivedTypeTables &tables_;
   std::map<const Symbol *, SymbolVector> orderedTypeParameters_;
for (const auto &pair : dtScope) {
       auto locationRestorer{common::ScopedSet(location_, symbol.name())};
       std::visit(
           common::visitors{
               [&](const TypeParamDetails &) {
                 // already handled above in declaration order
               },
               [&](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
               },
               [&](const GenericDetails &generic) {
                 DescribeGeneric(generic, specials);
               },
               [&](const auto &) {
SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget(
   return evaluate::AsGenericExpr(
       AsciiExpr{evaluate::Designator<Ascii>{symbol}});
 }
 
 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()};
   AddValue(values, componentSchema_, "name"s,
       SaveNameAsPointerTarget(scope, symbol.name().ToString()));
   AddValue(values, componentSchema_, "category"s,
       IntExpr<1>(static_cast<int>(dyType.category())));
   if (dyType.IsUnlimitedPolymorphic() ||
       dyType.category() == TypeCategory::Derived) {
     AddValue(values, componentSchema_, "kind"s, IntExpr<1>(0));
   } else {
     AddValue(values, componentSchema_, "kind"s, IntExpr<1>(dyType.kind()));
   }
   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)));
   } else {
     AddValue(values, componentSchema_, "characterlen"s,
         PackageIntValueExpr(deferredEnum_));
   }
   // Describe component's derived type
AddValue(values, componentSchema_, "lenvalue"s,
         SomeExpr{evaluate::NullPointer{}});
   }
   // Shape information
   int rank{evaluate::GetRank(shape)};
   AddValue(values, componentSchema_, "rank"s, IntExpr<1>(rank));
   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)),
           parameters));
       bounds.emplace_back(GetValue(
           evaluate::GetUpperBound(foldingContext, entity, j), parameters));
     }
     AddValue(values, componentSchema_, "bounds"s,

flang/module/__fortran_type_info.f90

type :: DerivedType
     type(SpecialBinding), pointer :: special(:)
   end type
 
   type :: Binding
     type(__builtin_c_funptr) :: proc
     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
     enumerator :: Deferred = 1, Explicit = 2, LenParameter = 3
   end enum
 
   type, bind(c) :: Value
     integer(1) :: genre ! Value::Genre

flang/test/Semantics/resolve69.f90

!ERROR: The type parameter LEN cannot be deferred without the POINTER or ALLOCATABLE attribute
   character(:), allocatable :: colonString3
 
 !ERROR: Must have INTEGER type, but is REAL(4)
   character(3.5) :: badParamValue
 
   type derived(typeKind, typeLen)
     integer, kind :: typeKind
     integer, len :: typeLen
+    character(typeKind) :: kindValue
+    character(typeLen) :: lenValue
   end type derived
 
   type (derived(constVal, 3)) :: constDerivedKind
 !ERROR: Value of kind type parameter 'typekind' (nonconstval) must be a scalar INTEGER constant
 !ERROR: Invalid specification expression: reference to local entity 'nonconstval'
   type (derived(nonConstVal, 3)) :: nonConstDerivedKind
 
   !OK because all type-params are constants
   type (derived(3, constVal)) :: constDerivedLen
 
 !ERROR: Invalid specification expression: reference to local entity 'nonconstval'
   type (derived(3, nonConstVal)) :: nonConstDerivedLen
 !ERROR: The value of type parameter 'typelen' cannot be deferred without the POINTER or ALLOCATABLE attribute
   type (derived(3, :)) :: colonDerivedLen
 !ERROR: The value of type parameter 'typekind' cannot be deferred without the POINTER or ALLOCATABLE attribute
 !ERROR: The value of type parameter 'typelen' cannot be deferred without the POINTER or ALLOCATABLE attribute
   type (derived( :, :)) :: colonDerivedLen1
   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

flang/test/Semantics/typeinfo01.f90

 !RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
 ! Tests for derived type runtime descriptions
 
 module m01
   type :: t1
     integer :: n
   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
   type :: parent
     integer :: pn
   end type
   type, extends(parent) :: child
     integer :: cn
type :: t(len)
     real, pointer :: pointer => target
     character(len=len) :: chauto
     real :: automatic(len)
   end type
 !CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t)
 !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