[flang] Fix character scalar result for REDUCE intrinsic call

[clementval]

The character reduce runtime functions expect a pointer to a scalar character of the correct length for the result of character reduce. A descriptor was passed so far. Fix the lowering so a proper temporary is created and passed to the runtime.

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

Author: Valentin Clement (バレンタイン クレメン) (clementval)

Changes

The character reduce runtime functions expect a pointer to a scalar character of the correct length for the result of character reduce. A descriptor was passed so far. Fix the lowering so a proper temporary is created and passed to the runtime.

---

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

2 Files Affected:

• (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+12-8)
• (modified) flang/test/Lower/Intrinsics/reduce.f90 (+30-8)

diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index c3ef96956be1c..4ef442ab57510 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -5777,15 +5777,19 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
       return builder.create<fir::LoadOp>(loc, result);
     }
     if (fir::isa_char(eleTy)) {
-      // Create mutable fir.box to be passed to the runtime for the result.
-      fir::MutableBoxValue resultMutableBox =
-          fir::factory::createTempMutableBox(builder, loc, eleTy);
-      mlir::Value resultIrBox =
-          fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
+      auto charTy = mlir::dyn_cast_or_null<fir::CharacterType>(resultType);
+      assert(charTy && "expect CharacterType");
+      fir::factory::CharacterExprHelper charHelper(builder, loc);
+      mlir::Value len;
+      if (charTy.hasDynamicLen())
+        len = charHelper.readLengthFromBox(fir::getBase(arrayTmp), charTy);
+      else
+        len = builder.createIntegerConstant(loc, builder.getI32Type(),
+                                            charTy.getLen());
+      fir::CharBoxValue temp = charHelper.createCharacterTemp(eleTy, len);
       fir::runtime::genReduce(builder, loc, array, operation, mask, identity,
-                              ordered, resultIrBox);
-      // Handle cleanup of allocatable result descriptor and return
-      return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE");
+                              ordered, temp.getBuffer());
+      return temp;
     }
     return fir::runtime::genReduce(builder, loc, array, operation, mask,
                                    identity, ordered);
diff --git a/flang/test/Lower/Intrinsics/reduce.f90 b/flang/test/Lower/Intrinsics/reduce.f90
index 842e626d7cc39..8d7b7798a94c5 100644
--- a/flang/test/Lower/Intrinsics/reduce.f90
+++ b/flang/test/Lower/Intrinsics/reduce.f90
@@ -348,21 +348,25 @@ subroutine char1(a)
   res = reduce(a, red_char1)
 end subroutine
 
-! CHECK: fir.call @_FortranAReduceChar1
+! CHECK: %[[CHRTMP:.*]] = fir.alloca !fir.char<1> {bindc_name = ".chrtmp"}
+! CHECK: %[[RESULT:.*]] = fir.convert %[[CHRTMP]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<i8>
+! CHECK: fir.call @_FortranAReduceChar1(%[[RESULT]], {{.*}})
 
 pure function red_char2(a,b)
-  character(kind=2), intent(in) :: a, b
-  character(kind=2) :: red_char2
+  character(kind=2, len=10), intent(in) :: a, b
+  character(kind=2, len=10) :: red_char2
   red_char2 = a // b
 end function
 
 subroutine char2(a)
-  character(kind=2), intent(in) :: a(:)
-  character(kind=2) :: res
+  character(kind=2, len=10), intent(in) :: a(:)
+  character(kind=2, len=10) :: res
   res = reduce(a, red_char2)
 end subroutine
 
-! CHECK: fir.call @_FortranAReduceChar2
+! CHECK: %[[CHRTMP:.*]] = fir.alloca !fir.char<2,10> {bindc_name = ".chrtmp"}
+! CHECK: %[[RESULT:.*]] = fir.convert %[[CHRTMP]] : (!fir.ref<!fir.char<2,10>>) -> !fir.ref<i16>
+! CHECK: fir.call @_FortranAReduceChar2(%[[RESULT]], {{.*}})
 
 pure function red_char4(a,b)
   character(kind=4), intent(in) :: a, b
@@ -598,8 +602,8 @@ subroutine char1dim(a)
 ! CHECK: fir.call @_FortranAReduceCharacter1Dim
 
 subroutine char2dim(a)
-  character(kind=2), intent(in) :: a(:, :)
-  character(kind=2), allocatable :: res(:)
+  character(kind=2, len=10), intent(in) :: a(:, :)
+  character(kind=2, len=10), allocatable :: res(:)
   res = reduce(a, red_char2, 2)
 end subroutine
 
@@ -613,4 +617,22 @@ subroutine char4dim(a)
 
 ! CHECK: fir.call @_FortranAReduceCharacter4Dim
 
+pure function red_char_dyn(a, b)
+  character(*), intent(In) :: a, b
+  character(max(len(a),len(b))) :: red_char_dyn
+  red_char_dyn = max(a, b)
+end function
+
+subroutine charDyn()
+  character(5) :: res
+  character(:), allocatable :: a(:)
+  allocate(character(10)::a(10))
+  res = reduce(a, red_char_dyn)
+end subroutine
+
+! CHECK: %[[BOX_ELESIZE:.*]] = fir.box_elesize %{{.*}} : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> index
+! CHECK: %[[CHRTMP:.*]] = fir.alloca !fir.char<1,?>(%[[BOX_ELESIZE]] : index) {bindc_name = ".chrtmp"}
+! CHECK: %[[RESULT:.*]] = fir.convert %[[CHRTMP]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+! CHECK: fir.call @_FortranAReduceChar1(%[[RESULT]], {{.*}})
+
 end module

[vzakhari]

LGTM

[psteinfeld]

All builds and tests correctly and looks good.