[flang] Handle substrings when they are on arguments to elemental functions.

Passing substrings as arguments to elemental functions needed fixing.
Specifically, when an array of characters with a substring operation on
the entire array was passed, the receiving procedure was getting the
array without the substring.

RefOpaque was not handling subscript operations in the action loop. Also
refactor the LEN computation code so it does not require an ArrayLoad.

Author: schweitzpgi

flang/include/flang/Optimizer/Builder/FIRBuilder.h

@@ -504,6 +504,11 @@ mlir::Value genLenOfCharacter(fir::FirOpBuilder &builder, mlir::Location loc,
                               fir::ArrayLoadOp arrLoad,
                               llvm::ArrayRef<mlir::Value> path,
                               llvm::ArrayRef<mlir::Value> substring);
+mlir::Value genLenOfCharacter(fir::FirOpBuilder &builder, mlir::Location loc,
+                              fir::SequenceType seqTy, mlir::Value memref,
+                              llvm::ArrayRef<mlir::Value> typeParams,
+                              llvm::ArrayRef<mlir::Value> path,
+                              llvm::ArrayRef<mlir::Value> substring);
 
 } // namespace fir::factory
 

flang/lib/Lower/ConvertExpr.cpp

@@ -4912,6 +4912,19 @@ class ArrayExprLowering {
         mlir::Value coor = builder.create<fir::ArrayCoorOp>(
             loc, refEleTy, memref, shape, slice, indices,
             fir::getTypeParams(extMemref));
+        if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
+          llvm::SmallVector<mlir::Value> substringBounds;
+          populateBounds(substringBounds, components.substring);
+          if (!substringBounds.empty()) {
+            mlir::Value dstLen = fir::factory::genLenOfCharacter(
+                builder, loc, arrTy.cast<fir::SequenceType>(), memref,
+                fir::getTypeParams(extMemref), iters.iterVec(),
+                substringBounds);
+            fir::CharBoxValue dstChar(coor, dstLen);
+            return fir::factory::CharacterExprHelper{builder, loc}
+                .createSubstring(dstChar, substringBounds);
+          }
+        }
         return fir::factory::arraySectionElementToExtendedValue(
             builder, loc, extMemref, coor, slice);
       };

flang/lib/Optimizer/Builder/FIRBuilder.cpp

@@ -1025,6 +1025,16 @@ fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {
 mlir::Value fir::factory::genLenOfCharacter(
     fir::FirOpBuilder &builder, mlir::Location loc, fir::ArrayLoadOp arrLoad,
     llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {
+  llvm::SmallVector<mlir::Value> typeParams(arrLoad.typeparams());
+  return genLenOfCharacter(builder, loc,
+                           arrLoad.getType().cast<fir::SequenceType>(),
+                           arrLoad.memref(), typeParams, path, substring);
+}
+
+mlir::Value fir::factory::genLenOfCharacter(
+    fir::FirOpBuilder &builder, mlir::Location loc, fir::SequenceType seqTy,
+    mlir::Value memref, llvm::ArrayRef<mlir::Value> typeParams,
+    llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {
   auto idxTy = builder.getIndexType();
   auto zero = builder.createIntegerConstant(loc, idxTy, 0);
   auto saturatedDiff = [&](mlir::Value lower, mlir::Value upper) {
@@ -1043,8 +1053,7 @@ mlir::Value fir::factory::genLenOfCharacter(
   auto lower = zero;
   if (substring.size() == 1)
     lower = builder.createConvert(loc, idxTy, substring.front());
-  auto arrTy = arrLoad.getType().cast<fir::SequenceType>();
-  auto eleTy = fir::applyPathToType(arrTy, path);
+  auto eleTy = fir::applyPathToType(seqTy, path);
   if (!fir::hasDynamicSize(eleTy)) {
     if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
       // Use LEN from the type.
@@ -1054,20 +1063,19 @@ mlir::Value fir::factory::genLenOfCharacter(
     fir::emitFatalError(loc,
                         "application of path did not result in a !fir.char");
   }
-  auto memref = arrLoad.memref();
   if (fir::isa_box_type(memref.getType())) {
     if (memref.getType().isa<fir::BoxCharType>())
       return builder.create<fir::BoxCharLenOp>(loc, idxTy, memref);
     if (memref.getType().isa<fir::BoxType>())
       return CharacterExprHelper(builder, loc).readLengthFromBox(memref);
     fir::emitFatalError(loc, "memref has wrong type");
   }
-  if (arrLoad.typeparams().empty()) {
+  if (typeParams.empty()) {
     fir::emitFatalError(loc, "array_load must have typeparams");
   }
-  if (fir::isa_char(arrTy.getEleTy())) {
-    assert(arrLoad.typeparams().size() == 1 && "too many typeparams");
-    return arrLoad.typeparams().front();
+  if (fir::isa_char(seqTy.getEleTy())) {
+    assert(typeParams.size() == 1 && "too many typeparams");
+    return typeParams.front();
   }
   TODO(loc, "LEN of character must be computed at runtime");
 }

flang/test/Lower/character-elemental.f90

@@ -0,0 +1,39 @@
+! RUN: bbc %s -o - | FileCheck %s
+
+! CHECK-LABEL: substring_main
+subroutine substring_main
+  character*7 :: string(2) = ['12     ', '12     ']
+  integer :: result(2)
+  integer :: ival
+
+  ival = 1
+  ! CHECK: %[[a0:.*]] = fir.alloca i32 {bindc_name = "ival", uniq_name = "_QFsubstring_mainEival"}
+  ! CHECK: %[[a2:.*]] = fir.address_of(@_QFsubstring_mainEstring) : !fir.ref<!fir.array<2x!fir.char<1,7>>>
+  ! CHECK: fir.store {{.*}} to %[[a0]] : !fir.ref<i32>
+  ! CHECK: %[[a3:.*]] = fir.shape {{.*}} : (index) -> !fir.shape<1>
+  ! CHECK: %[[a4:.*]] = fir.slice {{.*}}, {{.*}}, {{.*}} : (index, index, index) -> !fir.slice<1>
+  ! CHECK: br ^bb1({{.*}}, {{.*}} : index, index)
+  ! CHECK: ^bb1(%[[a5:.*]]: index, %[[a6:.*]]: index):  // 2 preds: ^bb0, ^bb2
+  ! CHECK: %[[a7:.*]] = arith.cmpi sgt, %[[a6]], {{.*}} : index
+  ! CHECK: cond_br %[[a7]], ^bb2, ^bb3
+  ! CHECK: ^bb2:  // pred: ^bb1
+  ! CHECK: %[[a8:.*]] = arith.addi %[[a5]], {{.*}} : index
+  ! CHECK: %[[a9:.*]] = fir.array_coor %[[a2]](%[[a3]]) [%[[a4]]] %[[a8]] : (!fir.ref<!fir.array<2x!fir.char<1,7>>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref<!fir.char<1,7>>
+  ! CHECK: %[[a10:.*]] = fir.load %[[a0]] : !fir.ref<i32>
+  ! CHECK: %[[a11:.*]] = fir.convert %[[a10]] : (i32) -> index
+  ! CHECK: %[[a12:.*]] = arith.subi %[[a11]], {{.*}} : index
+  ! CHECK: %[[a13:.*]] = fir.convert %[[a9]] : (!fir.ref<!fir.char<1,7>>) -> !fir.ref<!fir.array<7x!fir.char<1>>>
+  ! CHECK: %[[a14:.*]] = fir.coordinate_of %[[a13]], %[[a12]] : (!fir.ref<!fir.array<7x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+  ! CHECK: %[[a15:.*]] = fir.convert %[[a14]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.char<1,?>>
+  ! CHECK: %[[a16:.*]] = fir.emboxchar %[[a15]], {{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+  ! CHECK: %[[a17:.*]] = fir.call @_QFsubstring_mainPinner(%[[a16]]) : (!fir.boxchar<1>) -> i32
+  result = inner(string(1:2)(ival:ival))
+  print *, result
+contains
+  elemental function inner(arg)
+    character(len=*), intent(in) :: arg
+    integer :: inner
+
+    inner = len(arg)
+  end function inner
+end subroutine substring_main