[flang] Fix array substring emboxing code generation

[jeanPerier]

Summary

The code generation of the fir.embox op creating descriptors for
array substring with a non constant length base was using the
substring length to compute the first dimension result stride.
Fix it to use the input length instead.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Optimizer/CodeGen/CodeGen.cpp

static int getCFIAttr(fir::BaseBoxType boxTy) {
     auto eleTy = boxTy.getEleTy();
     if (eleTy.isa<fir::PointerType>())
       return CFI_attribute_pointer;
     if (eleTy.isa<fir::HeapType>())
       return CFI_attribute_allocatable;
     return CFI_attribute_other;
   }
 
+  mlir::Value getCharacterByteSize(mlir::Location loc,
+                                   mlir::ConversionPatternRewriter &rewriter,
+                                   fir::CharacterType charTy,
+                                   mlir::ValueRange lenParams) const {
+    auto i64Ty = mlir::IntegerType::get(rewriter.getContext(), 64);
+    mlir::Value size =
+        genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(charTy));
+    if (charTy.hasConstantLen())
+      return size; // Length accounted for in the genTypeStrideInBytes GEP.
+    // Otherwise,  multiply the single character size by the length.
+    assert(!lenParams.empty());
+    auto len64 = FIROpConversion<OP>::integerCast(loc, rewriter, i64Ty,
+                                                  lenParams.back());
+    return rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, size, len64);
+  }
+
   // Get the element size and CFI type code of the boxed value.
   std::tuple<mlir::Value, mlir::Value> getSizeAndTypeCode(
       mlir::Location loc, mlir::ConversionPatternRewriter &rewriter,
       mlir::Type boxEleTy, mlir::ValueRange lenParams = {}) const {
     auto i64Ty = mlir::IntegerType::get(rewriter.getContext(), 64);
     if (auto eleTy = fir::dyn_cast_ptrEleTy(boxEleTy))
       boxEleTy = eleTy;
     if (auto seqTy = boxEleTy.dyn_cast<fir::SequenceType>())
       return getSizeAndTypeCode(loc, rewriter, seqTy.getEleTy(), lenParams);
     if (boxEleTy.isa<mlir::NoneType>()) // unlimited polymorphic or assumed type
       return {rewriter.create<mlir::LLVM::ConstantOp>(loc, i64Ty, 0),
               this->genConstantOffset(loc, rewriter, CFI_type_other)};
     mlir::Value typeCodeVal = this->genConstantOffset(
         loc, rewriter,
         fir::getTypeCode(boxEleTy, this->lowerTy().getKindMap()));
     if (fir::isa_integer(boxEleTy) || boxEleTy.dyn_cast<fir::LogicalType>() ||
         fir::isa_real(boxEleTy) || fir::isa_complex(boxEleTy))
       return {genTypeStrideInBytes(loc, i64Ty, rewriter,
                                    this->convertType(boxEleTy)),
               typeCodeVal};
-    if (auto charTy = boxEleTy.dyn_cast<fir::CharacterType>()) {
-      mlir::Value size =
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(charTy));
-      if (charTy.getLen() == fir::CharacterType::unknownLen()) {
-        // Multiply the single character size by the length.
-        assert(!lenParams.empty());
-        auto len64 = FIROpConversion<OP>::integerCast(loc, rewriter, i64Ty,
-                                                      lenParams.back());
-        size = rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, size, len64);
-      }
-      return {size, typeCodeVal};
-    };
+    if (auto charTy = boxEleTy.dyn_cast<fir::CharacterType>())
+      return {getCharacterByteSize(loc, rewriter, charTy, lenParams),
+              typeCodeVal};
     if (fir::isa_ref_type(boxEleTy)) {
       auto ptrTy = mlir::LLVM::LLVMPointerType::get(
           mlir::LLVM::LLVMVoidType::get(rewriter.getContext()));
       return {genTypeStrideInBytes(loc, i64Ty, rewriter, ptrTy), typeCodeVal};
     }
     if (boxEleTy.isa<fir::RecordType>())
       return {genTypeStrideInBytes(loc, i64Ty, rewriter,
                                    this->convertType(boxEleTy)),
matchAndRewrite(fir::cg::XEmboxOp xbox, OpAdaptor adaptor,
                   mlir::ConversionPatternRewriter &rewriter) const override {
     mlir::ValueRange operands = adaptor.getOperands();
     mlir::Value sourceBox;
     mlir::Type sourceBoxType;
     if (xbox.getSourceBox()) {
       sourceBox = operands[xbox.getSourceBoxOffset()];
       sourceBoxType = xbox.getSourceBox().getType();
     }
-    auto [boxTy, dest, eleSize] = consDescriptorPrefix(
+    auto [boxTy, dest, resultEleSize] = consDescriptorPrefix(
         xbox, fir::unwrapRefType(xbox.getMemref().getType()), rewriter,
         xbox.getOutRank(), adaptor.getSubstr(), adaptor.getLenParams(),
         sourceBox, sourceBoxType);
     // Generate the triples in the dims field of the descriptor
     auto i64Ty = mlir::IntegerType::get(xbox.getContext(), 64);
     mlir::Value base = operands[0];
     assert(!xbox.getShape().empty() && "must have a shape");
     unsigned shapeOffset = xbox.shapeOffset();
matchAndRewrite(fir::cg::XEmboxOp xbox, OpAdaptor adaptor,
     mlir::Value ptrOffset = zero;
     mlir::Type memEleTy = fir::dyn_cast_ptrEleTy(xbox.getMemref().getType());
     assert(memEleTy.isa<fir::SequenceType>());
     auto seqTy = memEleTy.cast<fir::SequenceType>();
     mlir::Type seqEleTy = seqTy.getEleTy();
     // Adjust the element scaling factor if the element is a dependent type.
     if (fir::hasDynamicSize(seqEleTy)) {
       if (auto charTy = seqEleTy.dyn_cast<fir::CharacterType>()) {
-        prevPtrOff = eleSize;
+        prevPtrOff =
+            getCharacterByteSize(loc, rewriter, charTy, adaptor.getLenParams());
       } else if (seqEleTy.isa<fir::RecordType>()) {
         // prevPtrOff = ;
         TODO(loc, "generate call to calculate size of PDT");
       } else {
         fir::emitFatalError(loc, "unexpected dynamic type");
       }
     } else {
       constRows = seqTy.getConstantRows();
     }
 
     const auto hasSubcomp = !xbox.getSubcomponent().empty();
     const bool hasSubstr = !xbox.getSubstr().empty();
     // Initial element stride that will be use to compute the step in
-    // each dimension.
-    mlir::Value prevDimByteStride = eleSize;
+    // each dimension. Initially, this is the size of the input element.
+    // Note that when there are no components/substring, the resultEleSize
+    // that was previously computed matches the input element size.
+    mlir::Value prevDimByteStride = resultEleSize;
     if (hasSubcomp) {
       // We have a subcomponent. The step value needs to be the number of
       // bytes per element (which is a derived type).
       prevDimByteStride =
           genTypeStrideInBytes(loc, i64Ty, rewriter, convertType(seqEleTy));
     } else if (hasSubstr) {
       // We have a substring. The step value needs to be the number of bytes
       // per CHARACTER element.

flang/test/Fir/embox-substring.fir

 // RUN: fir-opt -o - -cg-rewrite --fir-to-llvm-ir %s | FileCheck %s
 // RUN: tco -o - -cg-rewrite --fir-to-llvm-ir %s | FileCheck %s
 
 // CHECK-LABEL: llvm.func @embox_index_substr(
 // CHECK-NOT: NULL_VALUE
 // CHECK-NOT: NULL_TYPE
 func.func @embox_index_substr(%addr : !fir.ref<!fir.array<?x!fir.char<1,2>>>) {
   %0 = arith.constant 0 : index
   %1 = fir.shape_shift %0, %0 : (index, index) -> !fir.shapeshift<1>
   %2 = fir.slice %0, %0, %0 substr %0, %0: (index, index, index, index, index) -> !fir.slice<1>
   %3 = fir.embox %addr (%1) [%2] : (!fir.ref<!fir.array<?x!fir.char<1,2>>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
   return
 }
+
+// CHARACTER(*) :: C(2)
+// CALL DUMP(C(:)(1:1))
+// Test that the resulting stride is based on the input length, not the substring one.
+func.func @substring_dyn_base(%base_addr: !fir.ref<!fir.array<2x!fir.char<1,?>>>, %base_len: index) {
+  %c0 = arith.constant 0 : index
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %2 = fircg.ext_embox %base_addr(%c2)[%c1, %c2, %c1] substr %c0, %c1 typeparams %base_len : (!fir.ref<!fir.array<2x!fir.char<1,?>>>, index, index, index, index, index, index, index) -> !fir.box<!fir.array<2x!fir.char<1>>>
+  fir.call @dump(%2) : (!fir.box<!fir.array<2x!fir.char<1>>>) -> ()
+  return
+}
+func.func private @dump(!fir.box<!fir.array<2x!fir.char<1>>>)
+
+// CHECK-LABEL:   llvm.func @substring_dyn_base(
+// CHECK-SAME:                                  %[[VAL_0:.*]]: !llvm.ptr<i8>,
+// CHECK-SAME:                                  %[[VAL_1:.*]]: i64) {
+// CHECK:           %[[VAL_5:.*]] = llvm.mlir.constant(1 : index) : i64
+// CHECK:           llvm.getelementptr
+// CHECK:           %[[VAL_28:.*]] = llvm.mlir.null : !llvm.ptr<i8>
+// CHECK:           %[[VAL_29:.*]] = llvm.getelementptr %[[VAL_28]][1] : (!llvm.ptr<i8>) -> !llvm.ptr<i8>
+// CHECK:           %[[VAL_30:.*]] = llvm.ptrtoint %[[VAL_29]] : !llvm.ptr<i8> to i64
+// CHECK:           %[[VAL_31:.*]] = llvm.mul %[[VAL_30]], %[[VAL_1]]  : i64
+// CHECK:           %[[VAL_42:.*]] = llvm.mul %[[VAL_31]], %[[VAL_5]]  : i64
+// CHECK:           %[[VAL_43:.*]] = llvm.insertvalue %[[VAL_42]], %{{.*}}[7, 0, 2] : !llvm.struct<(ptr<array<2 x array<1 x i8>>>, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>)>