[flang-commits] [flang] 9d162ec - [flang] Create a temporary of the correct size when lowering SetLength

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2022-08-24T16:56:37+02:00
New Revision: 9d162ecb3b436e84c2b6608814b2d2e2bd4530b1

URL: https://github.com/llvm/llvm-project/commit/9d162ecb3b436e84c2b6608814b2d2e2bd4530b1
DIFF: https://github.com/llvm/llvm-project/commit/9d162ecb3b436e84c2b6608814b2d2e2bd4530b1.diff

LOG: [flang] Create a temporary of the correct size when lowering SetLength

This patch creates a temporary of the appropriate length while lowering SetLength.

The corresponding character can be truncated or padded if necessary.

This fix issue with array constructor in argument and also with statement function.

```
  character(7) :: str = "1234567"
  call s(str(1:1))
contains
 subroutine s(a)
  character(*) :: a
  call s2([Character(3)::a])
 end subroutine
 subroutine s2(c)
  character(3) :: c(1)
  print "(4a)", c(1), "end"
 end subroutine
end
```

The example prior the patch prints `123end` instead of `1. end`

Reviewed By: PeteSteinfeld, jeanPerier

Differential Revision: https://reviews.llvm.org/D132464

Added: 
    

Modified: 
    flang/lib/Lower/ConvertExpr.cpp
    flang/test/Lower/statement-function.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index ac222078f59f..6fb1ca243269 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -1315,7 +1315,11 @@ class ScalarExprLowering {
   ExtValue genval(const Fortran::evaluate::SetLength<KIND> &x) {
     mlir::Value newLenValue = genunbox(x.right());
     fir::ExtendedValue lhs = gen(x.left());
-    return replaceScalarCharacterLength(lhs, newLenValue);
+    fir::factory::CharacterExprHelper charHelper(builder, getLoc());
+    fir::CharBoxValue temp = charHelper.createCharacterTemp(
+        charHelper.getCharacterType(fir::getBase(lhs).getType()), newLenValue);
+    charHelper.createAssign(temp, lhs);
+    return fir::ExtendedValue{temp};
   }
 
   template <int KIND>

diff  --git a/flang/test/Lower/statement-function.f90 b/flang/test/Lower/statement-function.f90
index b59b8fb1db9c..c672332c5b43 100644
--- a/flang/test/Lower/statement-function.f90
+++ b/flang/test/Lower/statement-function.f90
@@ -101,6 +101,7 @@ integer function test_stmt_character(c, j)
   test_stmt_character = func(c, j)
 end function
 
+
 ! Test statement function with a character actual argument whose
 ! length may be 
diff erent than the dummy length (the dummy length
 ! must be used inside the statement function).
@@ -145,3 +146,34 @@ subroutine bug247(r)
   PRINT *, I(2.5)
   ! CHECK: fir.call {{.*}}EndIo
 END subroutine bug247
+
+! Test that the argument is truncated to the length of the dummy argument.
+subroutine truncate_arg
+  character(4) arg
+  character(10) stmt_fct
+  stmt_fct(arg) = arg
+  print *, stmt_fct('longer_arg')
+end subroutine
+
+! CHECK-LABEL: @_QPtruncate_arg
+! CHECK: %[[c4:.*]] = arith.constant 4 : i32
+! CHECK: %[[arg:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,10>>
+! CHECK: %[[cast_arg:.*]] = fir.convert %[[arg]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK: %[[c10:.*]] = arith.constant 10 : i64
+! CHECK: %[[temp:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".chrtmp"}
+! CHECK: %[[c10_index:.*]] = fir.convert %[[c10]] : (i64) -> index
+! CHECK: %[[c4_index:.*]] = fir.convert %[[c4]] : (i32) -> index
+! CHECK: %[[cmpi:.*]] = arith.cmpi slt, %[[c10_index]], %[[c4_index]] : index
+! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[c10_index]], %[[c4_index]] : index
+! CHECK: %[[c1:.*]] = arith.constant 1 : i64
+! CHECK: %[[select_i64:.*]] = fir.convert %[[select]] : (index) -> i64
+! CHECK: %[[length:.*]] = arith.muli %[[c1]], %[[select_i64]] : i64
+! CHECK: %[[cast_temp_i8:.*]] = fir.convert %[[temp]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
+! CHECK: %[[cast_arg_i8:.*]] = fir.convert %[[cast_arg]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[cast_temp_i8]], %[[cast_arg_i8]], %[[length]], %{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+! CHECK: %[[c1_i64:.*]] = arith.constant 1 : i64
+! CHECK: %[[ub:.*]] = arith.subi %[[c10]], %[[c1_i64]] : i64
+! CHECK: %[[ub_index:.*]] = fir.convert %[[ub]] : (i64) -> index
+! CHECK: fir.do_loop %{{.*}} = %[[select]] to %[[ub_index]] step %{{.*}} {
+! CHECK: %[[cast_temp:.*]] = fir.convert %[[temp:.*]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
+! CHECK: %{{.*}} = fir.call @_FortranAioOutputAscii(%{{.*}}, %[[cast_temp]], %[[c10]]) : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1