[flang-commits] [flang] 32306b9 - [flang] Lower length on character storage

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2022-03-18T14:52:59+01:00
New Revision: 32306b9cf7d7836b583f5999db970dee4c18ca25

URL: https://github.com/llvm/llvm-project/commit/32306b9cf7d7836b583f5999db970dee4c18ca25
DIFF: https://github.com/llvm/llvm-project/commit/32306b9cf7d7836b583f5999db970dee4c18ca25.diff

LOG: [flang] Lower length on character storage

This patch adds lowering for SetLength used to set
different length on character storage around calls where
the dummy and actual length differ.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: PeteSteinfeld

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

Co-authored-by: Jean Perier <jperier at nvidia.com>

Added: 
    flang/test/Lower/set-length.f90

Modified: 
    flang/lib/Lower/ConvertExpr.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 6f2d528a6cc67..15483dd00833d 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -1092,7 +1092,9 @@ class ScalarExprLowering {
 
   template <int KIND>
   ExtValue genval(const Fortran::evaluate::SetLength<KIND> &x) {
-    TODO(getLoc(), "genval SetLength<KIND>");
+    mlir::Value newLenValue = genunbox(x.right());
+    fir::ExtendedValue lhs = gen(x.left());
+    return replaceScalarCharacterLength(lhs, newLenValue);
   }
 
   template <int KIND>

diff  --git a/flang/test/Lower/set-length.f90 b/flang/test/Lower/set-length.f90
new file mode 100644
index 0000000000000..ece117053dc84
--- /dev/null
+++ b/flang/test/Lower/set-length.f90
@@ -0,0 +1,28 @@
+! Test evaluate::SetLength lowering (used to set a 
diff erent length on a
+! character storage around calls where the dummy and actual length 
diff er).
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+
+subroutine takes_length_4(c)
+  character c(3)*4
+  !do i = 1,3
+  print *, c(i)
+  !enddo
+end
+
+! CHECK-LABEL: func @_QPfoo(
+subroutine foo(c)
+  character c(4)*3
+  ! evaluate::Expr is: CALL s(%SET_LENGTH(c(1_8),4_8)) after semantics.
+  call takes_length_4(c(1))
+! CHECK:         %[[VAL_2:.*]] = arith.constant 4 : i64
+! CHECK:         %[[VAL_6:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.array<4x!fir.char<1,3>>>, i64) -> !fir.ref<!fir.char<1,3>>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_2]] : (i64) -> index
+! CHECK:         %[[VAL_9:.*]] = fir.emboxchar %[[VAL_7]], %[[VAL_8]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:         fir.call @_QPtakes_length_4(%[[VAL_9]]) : (!fir.boxchar<1>) -> ()
+end subroutine
+
+  character(3) :: c(4) = ["abc", "def", "ghi", "klm"]
+  call foo(c)
+end