[flang-commits] [flang] b8e8f62 - [flang] Fold instantiated PDT character component length when needed

[Jean Perier via flang-commits]

Author: Jean Perier
Date: 2022-04-04T09:47:15+02:00
New Revision: b8e8f62d5e72c7f4fc61985406fb27714e2c2f7c

URL: https://github.com/llvm/llvm-project/commit/b8e8f62d5e72c7f4fc61985406fb27714e2c2f7c
DIFF: https://github.com/llvm/llvm-project/commit/b8e8f62d5e72c7f4fc61985406fb27714e2c2f7c.diff

LOG: [flang] Fold instantiated PDT character component length when needed

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.

Differential Revision: https://reviews.llvm.org/D122938

Added: 
    

Modified: 
    flang/include/flang/Evaluate/check-expression.h
    flang/lib/Evaluate/check-expression.cpp
    flang/lib/Semantics/type.cpp
    flang/test/Lower/derived-types-kind-params.f90
    flang/test/Semantics/offsets02.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index 21f48be0f7d34..a53c8dfb57e41 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -48,6 +48,8 @@ extern template bool IsScopeInvariantExpr(const Expr<SubscriptInteger> &);
 // expressions, including BOZ literals.
 template <typename A> bool IsActuallyConstant(const A &);
 extern template bool IsActuallyConstant(const Expr<SomeType> &);
+extern template bool IsActuallyConstant(const Expr<SomeInteger> &);
+extern template bool IsActuallyConstant(const Expr<SubscriptInteger> &);
 
 // Checks whether an expression is an object designator with
 // constant addressing and no vector-valued subscript.

diff  --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index bdff5f20892d4..c184fdc78a76b 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -192,6 +192,8 @@ template <typename A> bool IsActuallyConstant(const A &x) {
 }
 
 template bool IsActuallyConstant(const Expr<SomeType> &);
+template bool IsActuallyConstant(const Expr<SomeInteger> &);
+template bool IsActuallyConstant(const Expr<SubscriptInteger> &);
 
 // Object pointer initialization checking predicate IsInitialDataTarget().
 // This code determines whether an expression is allowable as the static

diff  --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index a92b936949bfb..790ab7d460f2b 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -425,11 +425,28 @@ const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) {
   }
 }
 
+/// 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 FoldCharacterLength(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::IsActuallyConstant(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 @@ const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
     return scope_.MakeLogicalType(KindExpr{kind});
   case DeclTypeSpec::Character:
     return scope_.MakeCharacterType(
-        ParamValue{spec.characterTypeSpec().length()}, KindExpr{kind});
+        FoldCharacterLength(foldingContext(), spec.characterTypeSpec()),
+        KindExpr{kind});
   default:
     CRASH_NO_CASE;
   }

diff  --git a/flang/test/Lower/derived-types-kind-params.f90 b/flang/test/Lower/derived-types-kind-params.f90
index 54cfdd1f5867f..54030b910e251 100644
--- a/flang/test/Lower/derived-types-kind-params.f90
+++ b/flang/test/Lower/derived-types-kind-params.f90
@@ -31,13 +31,13 @@ module m
 ! -----------------------------------------------------------------------------
 
   ! 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

diff  --git a/flang/test/Semantics/offsets02.f90 b/flang/test/Semantics/offsets02.f90
index c7b21aede00ae..387bbac5ff6d4 100644
--- a/flang/test/Semantics/offsets02.f90
+++ b/flang/test/Semantics/offsets02.f90
@@ -52,3 +52,13 @@ subroutine s3
   !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