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

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

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.

---
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
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

``````````

</details>


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