[flang-commits] [flang] [flang] Fix failure to fold character array (PR #123418)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/123418

When a character component reference is applied to a constant array of derived type, ensure that the length of the resulting character array is properly defined.

Fixes https://github.com/llvm/llvm-project/issues/123362.

>From eb269041e3d7a107af409442eb2b3bd36d3e7dbc Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 17 Jan 2025 14:55:57 -0800
Subject: [PATCH] [flang] Fix failure to fold character array

When a character component reference is applied to a constant
array of derived type, ensure that the length of the resulting
character array is properly defined.

Fixes https://github.com/llvm/llvm-project/issues/123362.
---
 flang/lib/Evaluate/fold-implementation.h        |  4 ++++
 flang/test/Evaluate/fold-arr-char-component.f90 | 11 +++++++++++
 2 files changed, 15 insertions(+)
 create mode 100644 flang/test/Evaluate/fold-arr-char-component.f90

diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 31d043f490fd85..4dcc737688ca07 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -290,6 +290,9 @@ std::optional<Constant<T>> Folder<T>::ApplyComponent(
             auto *typedExpr{UnwrapExpr<Expr<T>>(expr.value())};
             CHECK(typedExpr);
             array = std::make_unique<ArrayConstructor<T>>(*typedExpr);
+            if constexpr (T::category == TypeCategory::Character) {
+              array->set_LEN(Expr<SubscriptInteger>{value->LEN()});
+            }
           }
           if (subscripts) {
             if (auto element{ApplySubscripts(*value, *subscripts)}) {
@@ -407,6 +410,7 @@ template <typename T> Expr<T> Folder<T>::Folding(Designator<T> &&designator) {
 template <typename T>
 Constant<T> *Folder<T>::Folding(std::optional<ActualArgument> &arg) {
   if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) {
+    *expr = Fold(context_, std::move(*expr));
     if constexpr (T::category != TypeCategory::Derived) {
       if (!UnwrapExpr<Expr<T>>(*expr)) {
         if (const Symbol *
diff --git a/flang/test/Evaluate/fold-arr-char-component.f90 b/flang/test/Evaluate/fold-arr-char-component.f90
new file mode 100644
index 00000000000000..9835db960d4ae9
--- /dev/null
+++ b/flang/test/Evaluate/fold-arr-char-component.f90
@@ -0,0 +1,11 @@
+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Ensure that array-valued component references have lengths
+! (see https://github.com/llvm/llvm-project/issues/123362)
+module m
+  type cdt
+    character(7) :: a = "ibm704", b = "cdc6600"
+  end type
+  type(cdt), parameter :: arr(2) = cdt()
+  integer, parameter :: check(*) = scan(arr%a, arr%b)
+  logical, parameter :: test1 = all(check == 5) ! the '0'
+end