[flang] Fix LBOUND with assumed size array and non constant DIM

[clementval]

Summary

LBOUND with a non constant DIM argument use the runtime to allow runtime
verification of DIM <= RANK. The interface uses a descriptor. This caused
undefined behavior because the runtime believed it was seeing an explicit
shape arrays with zero extent and returned 1 (the runtime descriptor
does not allow making a difference between an explicit shape and an
assumed size. Assumed size are not meant to be described by runtime
descriptors).

Fix the issue by setting the last extent of assumed size to 1 when
creating the descriptor to inquire about the LBOUND with the runtime.

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

Co-authored-by: Jean Perier <[e-mail]>

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/IntrinsicCall.cpp

builder.genIfThen(loc, lenIsPresentAtRuntime)
         .end();
   }
 }
 
 // IAND
 mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
                                       llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
-  return builder.create<mlir::arith::AndIOp>(loc, args[0], args[1]);
+  auto arg0 = builder.createConvert(loc, resultType, args[0]);
+  auto arg1 = builder.createConvert(loc, resultType, args[1]);
+  return builder.create<mlir::arith::AndIOp>(loc, arg0, arg1);
 }
 
 // IBCLR
 mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,
                                        llvm::ArrayRef<mlir::Value> args) {
   // A conformant IBCLR(I,POS) call satisfies:
   //     POS >= 0
   //     POS < BIT_SIZE(I)
static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,
   mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);
   zero = builder.createConvert(loc, extent.getType(), zero);
   auto dimIsEmpty = builder.create<mlir::arith::CmpIOp>(
       loc, mlir::arith::CmpIPredicate::eq, extent, zero);
   one = builder.createConvert(loc, lb.getType(), one);
   return builder.create<mlir::arith::SelectOp>(loc, dimIsEmpty, one, lb);
 }
 
+/// Create a fir.box to be passed to the LBOUND runtime.
+/// This ensure that local lower bounds of assumed shape are propagated and that
+/// a fir.box with equivalent LBOUNDs but an explicit shape is created for
+/// assumed size arrays to avoid undefined behaviors in codegen or the runtime.
+static mlir::Value createBoxForLBOUND(mlir::Location loc,
+                                      fir::FirOpBuilder &builder,
+                                      const fir::ExtendedValue &array) {
+  if (!array.isAssumedSize())
+    return array.match(
+        [&](const fir::BoxValue &boxValue) -> mlir::Value {
+          // This entity is mapped to a fir.box that may not contain the local
+          // lower bound information if it is a dummy. Rebox it with the local
+          // shape information.
+          mlir::Value localShape = builder.createShape(loc, array);
+          mlir::Value oldBox = boxValue.getAddr();
+          return builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox,
+                                              localShape,
+                                              /*slice=*/mlir::Value{});
+        },
+        [&](const auto &) -> mlir::Value {
+          // This a pointer/allocatable, or an entity not yet tracked with a
+          // fir.box. For pointer/allocatable, createBox will forward the
+          // descriptor that contains the correct lower bound information. For
+          // other entities, a new fir.box will be made with the local lower
+          // bounds.
+          return builder.createBox(loc, array);
+        });
+  // Assumed sized are not meant to be emboxed. This could cause the undefined
+  // extent cannot safely be understood by the runtime/codegen that will
+  // consider that the dimension is empty and that the related LBOUND value must
+  // be one. Pretend that the related extent is one to get the correct LBOUND
+  // value.
+  llvm::SmallVector<mlir::Value> shape =
+      fir::factory::getExtents(loc, builder, array);
+  assert(!shape.empty() && "assumed size must have at least one dimension");
+  shape.back() = builder.createIntegerConstant(loc, builder.getIndexType(), 1);
+  auto safeToEmbox = array.match(
+      [&](const fir::CharArrayBoxValue &x) -> fir::ExtendedValue {
+        return fir::CharArrayBoxValue{x.getAddr(), x.getLen(), shape,
+                                      x.getLBounds()};
+      },
+      [&](const fir::ArrayBoxValue &x) -> fir::ExtendedValue {
+        return fir::ArrayBoxValue{x.getAddr(), shape, x.getLBounds()};
+      },
+      [&](const auto &) -> fir::ExtendedValue {
+        fir::emitFatalError(loc, "not an assumed size array");
+      });
+  return builder.createBox(loc, safeToEmbox);
+}
+
 // LBOUND
 fir::ExtendedValue
 IntrinsicLibrary::genLbound(mlir::Type resultType,
                             llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 2 || args.size() == 3);
   const fir::ExtendedValue &array = args[0];
   if (const auto *boxValue = array.getBoxOf<fir::BoxValue>())
     if (boxValue->hasAssumedRank())
IntrinsicLibrary::genLbound(mlir::Type resultType,
   if (llvm::Optional<std::int64_t> cstDim =
           fir::factory::getIntIfConstant(dim)) {
     mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
     mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
     mlir::Value lb = computeLBOUND(builder, loc, array, *cstDim - 1, zero, one);
     return builder.createConvert(loc, resultType, lb);
   }
 
-  mlir::Value box = array.match(
-      [&](const fir::BoxValue &boxValue) -> mlir::Value {
-        // This entity is mapped to a fir.box that may not contain the local
-        // lower bound information if it is a dummy. Rebox it with the local
-        // shape information.
-        mlir::Value localShape = builder.createShape(loc, array);
-        mlir::Value oldBox = boxValue.getAddr();
-        return builder.create<fir::ReboxOp>(
-            loc, oldBox.getType(), oldBox, localShape, /*slice=*/mlir::Value{});
-      },
-      [&](const auto &) -> mlir::Value {
-        // This a pointer/allocatable, or an entity not yet tracked with a
-        // fir.box. For pointer/allocatable, createBox will forward the
-        // descriptor that contains the correct lower bound information. For
-        // other entities, a new fir.box will be made with the local lower
-        // bounds.
-        return builder.createBox(loc, array);
-      });
-
+  fir::ExtendedValue box = createBoxForLBOUND(loc, builder, array);
   return builder.createConvert(
       loc, resultType,
       fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim));
 }
 
 // UBOUND
 fir::ExtendedValue
 IntrinsicLibrary::genUbound(mlir::Type resultType,

flang/test/Lower/Intrinsics/lbound.f90

 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_4]] : (!fir.box<!fir.array<?x?xf32>>) -> !fir.box<none>
 ! CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (i64) -> i32
 ! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_5]]
 ! CHECK:  %[[VAL_9:.*]] = fir.call @_FortranALboundDim(%[[VAL_6]], %[[VAL_7]], %[[VAL_8]], %{{.*}}) : (!fir.box<none>, i32, !fir.ref<i8>, i32) -> i64
 ! CHECK:         fir.store %[[VAL_9]] to %arg2 : !fir.ref<i64>
   res = lbound(a, dim, 8)
 end subroutine
 
-! CHECK:  %[[VAL_0:.*]] = fir.undefined index
 subroutine lbound_test_3(a, dim, res)
   real, dimension(2:10, 3:*) :: a
   integer(8):: dim, res
 ! CHECK:  %[[VAL_1:.*]] = fir.load %arg1 : !fir.ref<i64>
+! CHECK:  %[[VAL_0:.*]] = arith.constant 1 : index
 ! CHECK:  %[[VAL_2:.*]] = fir.shape_shift %{{.*}}, %{{.*}}, %{{.*}}, %[[VAL_0]] : (index, index, index, index) -> !fir.shapeshift<2>
 ! CHECK:         %[[VAL_3:.*]] = fir.embox %arg0(%[[VAL_2]]) : (!fir.ref<!fir.array<9x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.array<9x?xf32>>
 ! CHECK:         %[[VAL_4:.*]] = fir.address_of(
 ! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_3]] : (!fir.box<!fir.array<9x?xf32>>) -> !fir.box<none>
 ! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_1]] : (i64) -> i32
 ! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_4]]
 ! CHECK:         %[[VAL_8:.*]] = fir.call @_FortranALboundDim(%[[VAL_5]], %[[VAL_6]], %[[VAL_7]], %{{.*}}) : (!fir.box<none>, i32, !fir.ref<i8>, i32) -> i64
 ! CHECK:         fir.store %[[VAL_8]] to %arg2 : !fir.ref<i64>