[flang] Fix failure to fold character array

[klausler]

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 #123362.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

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 #123362.

---

Full diff: https://github.com/llvm/llvm-project/pull/123418.diff

2 Files Affected:

• (modified) flang/lib/Evaluate/fold-implementation.h (+4)
• (added) flang/test/Evaluate/fold-arr-char-component.f90 (+11)

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

[DanielCChen]

LGTM.
Thanks for the quick fix!