[flang-commits] [flang] 3eedff3 - [flang][hlfir] Inherit constant length for the result of hlfir.transpose.

Slava Zakharin via flang-commits flang-commits at lists.llvm.org
Mon Jul 24 10:12:47 PDT 2023


Author: Slava Zakharin
Date: 2023-07-24T10:12:39-07:00
New Revision: 3eedff3c0466300fc4345768cd622aa6d4eebfd9

URL: https://github.com/llvm/llvm-project/commit/3eedff3c0466300fc4345768cd622aa6d4eebfd9
DIFF: https://github.com/llvm/llvm-project/commit/3eedff3c0466300fc4345768cd622aa6d4eebfd9.diff

LOG: [flang][hlfir] Inherit constant length for the result of hlfir.transpose.

Character length may be unknown for the type of Fortran::evaluate::FunctionRef
expression, but we can try to propagate it from the argument of
TRANSPOSE if it is known constant. Alternatively, we could relax
hlfir.transpose verification (i.e. allow character types mismatch
for the argument and the result).

Depends on D155912

Reviewed By: tblah

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

Added: 
    

Modified: 
    flang/lib/Lower/HlfirIntrinsics.cpp
    flang/test/Lower/HLFIR/transpose.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp
index 1b8631e0adeb3b..ab569adaf6f46f 100644
--- a/flang/lib/Lower/HlfirIntrinsics.cpp
+++ b/flang/lib/Lower/HlfirIntrinsics.cpp
@@ -278,6 +278,18 @@ mlir::Value HlfirTransposeLowering::lowerImpl(
   mlir::Type elementType = array.getEleTy();
   resultShape.push_back(arrayShape[0]);
   resultShape.push_back(arrayShape[1]);
+  if (auto resCharType = mlir::dyn_cast<fir::CharacterType>(elementType))
+    if (!resCharType.hasConstantLen()) {
+      // The FunctionRef expression might have imprecise character
+      // type at this point, and we can improve it by propagating
+      // the constant length from the argument.
+      auto argCharType = mlir::dyn_cast<fir::CharacterType>(
+          hlfir::getFortranElementType(operands[0].getType()));
+      if (argCharType && argCharType.hasConstantLen())
+        elementType = fir::CharacterType::get(
+            builder.getContext(), resCharType.getFKind(), argCharType.getLen());
+    }
+
   mlir::Type resultTy =
       hlfir::ExprType::get(builder.getContext(), resultShape, elementType,
                            fir::isPolymorphicType(stmtResultType));

diff  --git a/flang/test/Lower/HLFIR/transpose.f90 b/flang/test/Lower/HLFIR/transpose.f90
index 70ae3724d1ccb2..e63e1ec1d6890d 100644
--- a/flang/test/Lower/HLFIR/transpose.f90
+++ b/flang/test/Lower/HLFIR/transpose.f90
@@ -62,3 +62,40 @@ end subroutine test_polymorphic_result
 ! CHECK:           hlfir.destroy %[[VAL_5]] : !hlfir.expr<?x?xnone?>
 ! CHECK:           return
 ! CHECK:         }
+
+! Test that hlfir.transpose lowering inherits constant
+! character length from the argument, when the length
+! is uknown from the Fortran::evaluate expression type.
+subroutine test_unknown_char_len_result
+  character(len=3), dimension(3,3) :: w
+  character(len=2), dimension(3,3) :: w2
+  w2 = transpose(w(:,:)(1:2))
+end subroutine test_unknown_char_len_result
+! CHECK-LABEL:   func.func @_QPtest_unknown_char_len_result() {
+! CHECK:           %[[VAL_0:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_1:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_2:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_3:.*]] = fir.alloca !fir.array<3x3x!fir.char<1,3>> {bindc_name = "w", uniq_name = "_QFtest_unknown_char_len_resultEw"}
+! CHECK:           %[[VAL_4:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2>
+! CHECK:           %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_4]]) typeparams %[[VAL_0]] {uniq_name = "_QFtest_unknown_char_len_resultEw"} : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, !fir.shape<2>, index) -> (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, !fir.ref<!fir.array<3x3x!fir.char<1,3>>>)
+! CHECK:           %[[VAL_6:.*]] = arith.constant 2 : index
+! CHECK:           %[[VAL_7:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_8:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_9:.*]] = fir.alloca !fir.array<3x3x!fir.char<1,2>> {bindc_name = "w2", uniq_name = "_QFtest_unknown_char_len_resultEw2"}
+! CHECK:           %[[VAL_10:.*]] = fir.shape %[[VAL_7]], %[[VAL_8]] : (index, index) -> !fir.shape<2>
+! CHECK:           %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_9]](%[[VAL_10]]) typeparams %[[VAL_6]] {uniq_name = "_QFtest_unknown_char_len_resultEw2"} : (!fir.ref<!fir.array<3x3x!fir.char<1,2>>>, !fir.shape<2>, index) -> (!fir.ref<!fir.array<3x3x!fir.char<1,2>>>, !fir.ref<!fir.array<3x3x!fir.char<1,2>>>)
+! CHECK:           %[[VAL_12:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_13:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_14:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_15:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_16:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_17:.*]] = fir.shape %[[VAL_14]], %[[VAL_16]] : (index, index) -> !fir.shape<2>
+! CHECK:           %[[VAL_18:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_19:.*]] = arith.constant 2 : index
+! CHECK:           %[[VAL_20:.*]] = arith.constant 2 : index
+! CHECK:           %[[VAL_21:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_12]]:%[[VAL_1]]:%[[VAL_13]], %[[VAL_12]]:%[[VAL_2]]:%[[VAL_15]]) substr %[[VAL_18]], %[[VAL_19]]  shape %[[VAL_17]] typeparams %[[VAL_20]] : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.box<!fir.array<3x3x!fir.char<1,2>>>
+! CHECK:           %[[VAL_22:.*]] = hlfir.transpose %[[VAL_21]] : (!fir.box<!fir.array<3x3x!fir.char<1,2>>>) -> !hlfir.expr<3x3x!fir.char<1,2>>
+! CHECK:           hlfir.assign %[[VAL_22]] to %[[VAL_11]]#0 : !hlfir.expr<3x3x!fir.char<1,2>>, !fir.ref<!fir.array<3x3x!fir.char<1,2>>>
+! CHECK:           hlfir.destroy %[[VAL_22]] : !hlfir.expr<3x3x!fir.char<1,2>>
+! CHECK:           return
+! CHECK:         }


        


More information about the flang-commits mailing list