[flang-commits] [PATCH] D122938: [flang] Fold instantiated PDT character component length when needed

[Jean Perier via Phabricator via flang-commits]

jeanPerier created this revision.
jeanPerier added reviewers: klausler, schweitz.
jeanPerier added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
jeanPerier requested review of this revision.

In case a character component PDT length only depends on kind parameters,
fold it while instantiating the PDT. This is especially important if the
component has an initializer because later semantic phases (offset
computation or runtime type info generation) might get confused and
generate offset/type info that will lead to crashes in lowering.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D122938

Files:
  flang/lib/Semantics/type.cpp
  flang/test/Lower/derived-types-kind-params.f90
  flang/test/Semantics/offsets02.f90


Index: flang/test/Semantics/offsets02.f90
===================================================================
--- flang/test/Semantics/offsets02.f90
+++ flang/test/Semantics/offsets02.f90
@@ -52,3 +52,13 @@
   !CHECK: d3 size=24 offset=40:
   type(t(4, 20)) :: x4
 end
+
+subroutine s4
+  type t(k)
+    integer, kind :: k
+    character(len=k) :: c
+  end type
+  type(t(7)) :: x4
+  !CHECK: DerivedType scope: size=7 alignment=1 instantiation of t(k=7_4)
+  !CHECK: c size=7 offset=0: ObjectEntity type: CHARACTER(7_4,1)
+end subroutine
Index: flang/test/Lower/derived-types-kind-params.f90
===================================================================
--- flang/test/Lower/derived-types-kind-params.f90
+++ flang/test/Lower/derived-types-kind-params.f90
@@ -31,13 +31,13 @@
 ! -----------------------------------------------------------------------------
 
   ! CHECK-LABEL: func @_QMmPfoo
-  ! CHECK-SAME: !fir.ref<!fir.type<_QMmTtK7K12{c:!fir.array<12x!fir.char<1,?>>
+  ! CHECK-SAME: !fir.ref<!fir.type<_QMmTtK7K12{c:!fir.array<12x!fir.char<1,7>>
   subroutine foo(at)
     type(t(k2=12)) :: at
   end subroutine
 
   ! CHECK-LABEL: func @_QMmPfoo2
-  ! CHECK-SAME: !fir.ref<!fir.type<_QMmTt2K12K13{at:!fir.type<_QMmTtK15K17{c:!fir.array<17x!fir.char<1,?>>}>}>>
+  ! CHECK-SAME: !fir.ref<!fir.type<_QMmTt2K12K13{at:!fir.type<_QMmTtK15K17{c:!fir.array<17x!fir.char<1,15>>}>}>>
   subroutine foo2(at2)
     type(t2(12, 13)) :: at2
   end subroutine
Index: flang/lib/Semantics/type.cpp
===================================================================
--- flang/lib/Semantics/type.cpp
+++ flang/lib/Semantics/type.cpp
@@ -399,7 +399,7 @@
   } else if (auto *procDetails{newSymbol.detailsIf<ProcEntityDetails>()}) {
     // We have a procedure pointer.  Instantiate its return type
     if (const DeclTypeSpec * returnType{InstantiateType(newSymbol)}) {
-      ProcInterface &interface{procDetails->interface()};
+      ProcInterface &interface { procDetails->interface() };
       if (!interface.symbol()) {
         // Don't change the type for interfaces based on symbols
         interface.set_type(*returnType);
@@ -425,11 +425,28 @@
   }
 }
 
+/// Fold explicit length parameters of character components when the explicit
+/// expression is a constant expression (if it only depends on KIND parameters).
+/// Do not fold `character(len=pdt_length)`, even if the length parameter is
+/// constant in the pdt instantiation, in order to avoid losing the information
+/// that the character component is automatic (and must be a descriptor).
+static ParamValue FoldCharaterLength(evaluate::FoldingContext &foldingContext,
+    const CharacterTypeSpec &characterSpec) {
+  if (const auto &len{characterSpec.length().GetExplicit()}) {
+    if (evaluate::IsConstantExpr(*len)) {
+      return ParamValue{evaluate::Fold(foldingContext, common::Clone(*len)),
+          common::TypeParamAttr::Len};
+    }
+  }
+  return characterSpec.length();
+}
+
 // Apply type parameter values to an intrinsic type spec.
 const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
     SourceName symbolName, const DeclTypeSpec &spec) {
   const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())};
-  if (evaluate::ToInt64(intrinsic.kind())) {
+  if (spec.category() != DeclTypeSpec::Character &&
+      evaluate::ToInt64(intrinsic.kind())) {
     return spec; // KIND is already a known constant
   }
   // The expression was not originally constant, but now it must be so
@@ -454,7 +471,8 @@
     return scope_.MakeLogicalType(KindExpr{kind});
   case DeclTypeSpec::Character:
     return scope_.MakeCharacterType(
-        ParamValue{spec.characterTypeSpec().length()}, KindExpr{kind});
+        FoldCharaterLength(foldingContext(), spec.characterTypeSpec()),
+        KindExpr{kind});
   default:
     CRASH_NO_CASE;
   }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D122938.419852.patch
Type: text/x-patch
Size: 3832 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220401/410b4d4f/attachment-0001.bin>