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

[via flang-commits]

Author: Peter Klausler
Date: 2025-01-27T08:46:02-08:00
New Revision: 73f9034036c942058827877a657d72071dd766e7

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

LOG: [flang] Fix failure to fold character array (#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.

Added: 
    flang/test/Evaluate/fold-arr-char-component.f90

Modified: 
    flang/lib/Evaluate/fold-implementation.h

Removed: 
    


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