[flang-commits] [flang] [flang] Update UBOUND runtime API and lowering (PR #95085)

via flang-commits flang-commits at lists.llvm.org
Wed Jun 12 00:29:07 PDT 2024


https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/95085

>From 2ebba31e353f813d284b37773bfe5898c4a693d8 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Fri, 7 Jun 2024 16:32:08 -0700
Subject: [PATCH 1/2] [flang] Update UBOUND runtime API and lowering

LBOUND and SHAPE runtime were added with an API that avoids
making a dynamic allocation for the small result storage.
Update the UBOUND API that was already there and used in lowering
outside of the assumed-rank case.
Add tests for the assumed-rank case.
---
 flang/include/flang/Runtime/inquiry.h         |   2 +-
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 145 +++++++++---------
 flang/runtime/inquiry.cpp                     |  22 +--
 .../Lower/HLFIR/assumed-rank-inquiries-3.f90  |  83 ++++++++++
 flang/test/Lower/Intrinsics/ubound01.f90      |   2 +-
 flang/unittests/Runtime/Inquiry.cpp           |  56 ++++---
 6 files changed, 192 insertions(+), 118 deletions(-)

diff --git a/flang/include/flang/Runtime/inquiry.h b/flang/include/flang/Runtime/inquiry.h
index dde6e722ad6e9..c7a7487f1a1b1 100644
--- a/flang/include/flang/Runtime/inquiry.h
+++ b/flang/include/flang/Runtime/inquiry.h
@@ -35,7 +35,7 @@ std::int64_t RTDECL(Size)(
 std::int64_t RTDECL(SizeDim)(const Descriptor &array, int dim,
     const char *sourceFile = nullptr, int line = 0);
 
-void RTDECL(Ubound)(Descriptor &result, const Descriptor &array, int kind,
+void RTDECL(Ubound)(void *result, const Descriptor &array, int kind,
     const char *sourceFile = nullptr, int line = 0);
 
 } // extern "C"
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 4cdf1f2d98caa..c4e946a5d25c9 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -6056,33 +6056,80 @@ mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
                                    fir::getBase(args[1])));
 }
 
+/// Create a fir.box to be passed to the LBOUND/UBOUND runtime.
+/// This ensure that local lower bounds of assumed shape are propagated and that
+/// a fir.box with equivalent LBOUNDs.
+static mlir::Value
+createBoxForRuntimeBoundInquiry(mlir::Location loc, fir::FirOpBuilder &builder,
+                                const fir::ExtendedValue &array) {
+  // Assumed-rank descriptor must always carry accurate lower bound information
+  // in lowering since they cannot be tracked on the side in a vector at compile
+  // time.
+  if (array.hasAssumedRank())
+    return builder.createBox(loc, array);
+
+  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 is 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);
+      });
+}
+
 /// Generate runtime call to inquire about all the bounds/extents of an
-/// assumed-rank array.
+/// array (or an assumed-rank).
 template <typename Func>
-static fir::ExtendedValue genAssumedRankBoundInquiry(
-    fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type resultType,
-    llvm::ArrayRef<fir::ExtendedValue> args, int kindPos, Func genRtCall) {
+static fir::ExtendedValue
+genBoundInquiry(fir::FirOpBuilder &builder, mlir::Location loc,
+                mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args,
+                int kindPos, Func genRtCall, bool needAccurateLowerBound) {
   const fir::ExtendedValue &array = args[0];
-  // Allocate an array with the maximum rank, that is big enough to hold the
-  // result but still "small" (15 elements). Static size alloca make stack
-  // analysis/manipulation easier.
+  const bool hasAssumedRank = array.hasAssumedRank();
   mlir::Type resultElementType = fir::unwrapSequenceType(resultType);
-  mlir::Type allocSeqType =
-      fir::SequenceType::get({Fortran::common::maxRank}, resultElementType);
+  // For assumed-rank arrays, allocate an array with the maximum rank, that is
+  // big enough to hold the result but still "small" (15 elements). Static size
+  // alloca make stack analysis/manipulation easier.
+  int rank = hasAssumedRank ? Fortran::common::maxRank : array.rank();
+  mlir::Type allocSeqType = fir::SequenceType::get(rank, resultElementType);
   mlir::Value resultStorage = builder.createTemporary(loc, allocSeqType);
-  mlir::Value arrayBox = builder.createBox(loc, array);
+  mlir::Value arrayBox =
+      needAccurateLowerBound
+          ? createBoxForRuntimeBoundInquiry(loc, builder, array)
+          : builder.createBox(loc, array);
   mlir::Value kind = isStaticallyAbsent(args, kindPos)
                          ? builder.createIntegerConstant(
                                loc, builder.getI32Type(),
                                builder.getKindMap().defaultIntegerKind())
                          : fir::getBase(args[kindPos]);
   genRtCall(builder, loc, resultStorage, arrayBox, kind);
-  mlir::Type baseType =
-      fir::ReferenceType::get(builder.getVarLenSeqTy(resultElementType));
-  mlir::Value resultBase = builder.createConvert(loc, baseType, resultStorage);
-  mlir::Value rank =
-      builder.create<fir::BoxRankOp>(loc, builder.getIndexType(), arrayBox);
-  return fir::ArrayBoxValue{resultBase, {rank}};
+  if (hasAssumedRank) {
+    // Cast to fir.ref<array<?xik>> since the result extent is not a compile
+    // time constant.
+    mlir::Type baseType =
+        fir::ReferenceType::get(builder.getVarLenSeqTy(resultElementType));
+    mlir::Value resultBase =
+        builder.createConvert(loc, baseType, resultStorage);
+    mlir::Value rankValue =
+        builder.create<fir::BoxRankOp>(loc, builder.getIndexType(), arrayBox);
+    return fir::ArrayBoxValue{resultBase, {rankValue}};
+  }
+  // Result extent is a compile time constant in the other cases.
+  mlir::Value rankValue =
+      builder.createIntegerConstant(loc, builder.getIndexType(), rank);
+  return fir::ArrayBoxValue{resultStorage, {rankValue}};
 }
 
 // SHAPE
@@ -6092,8 +6139,9 @@ IntrinsicLibrary::genShape(mlir::Type resultType,
   assert(args.size() >= 1);
   const fir::ExtendedValue &array = args[0];
   if (array.hasAssumedRank())
-    return genAssumedRankBoundInquiry(builder, loc, resultType, args,
-                                      /*kindPos=*/1, fir::runtime::genShape);
+    return genBoundInquiry(builder, loc, resultType, args,
+                           /*kindPos=*/1, fir::runtime::genShape,
+                           /*needAccurateLowerBound=*/false);
   int rank = array.rank();
   mlir::Type indexType = builder.getIndexType();
   mlir::Type extentType = fir::unwrapSequenceType(resultType);
@@ -6329,33 +6377,6 @@ static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,
   return builder.create<mlir::arith::SelectOp>(loc, dimIsEmpty, one, lb);
 }
 
-/// Create a fir.box to be passed to the LBOUND/UBOUND runtime.
-/// This ensure that local lower bounds of assumed shape are propagated and that
-/// a fir.box with equivalent LBOUNDs.
-static mlir::Value
-createBoxForRuntimeBoundInquiry(mlir::Location loc, fir::FirOpBuilder &builder,
-                                const fir::ExtendedValue &array) {
-  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 is 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);
-      });
-}
-
 // LBOUND
 fir::ExtendedValue
 IntrinsicLibrary::genLbound(mlir::Type resultType,
@@ -6366,8 +6387,9 @@ IntrinsicLibrary::genLbound(mlir::Type resultType,
   // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]).
   const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1);
   if (array.hasAssumedRank() && dimIsAbsent)
-    return genAssumedRankBoundInquiry(builder, loc, resultType, args,
-                                      /*kindPos=*/1, fir::runtime::genLbound);
+    return genBoundInquiry(builder, loc, resultType, args,
+                           /*kindPos=*/1, fir::runtime::genLbound,
+                           /*needAccurateLowerBound=*/true);
 
   mlir::Type indexType = builder.getIndexType();
 
@@ -6419,7 +6441,8 @@ fir::ExtendedValue
 IntrinsicLibrary::genUbound(mlir::Type resultType,
                             llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 3 || args.size() == 2);
-  if (args.size() == 3) {
+  const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1);
+  if (!dimIsAbsent) {
     // Handle calls to UBOUND with the DIM argument, which return a scalar
     mlir::Value extent = fir::getBase(genSize(resultType, args));
     mlir::Value lbound = fir::getBase(genLbound(resultType, args));
@@ -6427,28 +6450,12 @@ IntrinsicLibrary::genUbound(mlir::Type resultType,
     mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
     mlir::Value ubound = builder.create<mlir::arith::SubIOp>(loc, lbound, one);
     return builder.create<mlir::arith::AddIOp>(loc, ubound, extent);
-  } else {
-    // Handle calls to UBOUND without the DIM argument, which return an array
-    mlir::Value kind = isStaticallyAbsent(args[1])
-                           ? builder.createIntegerConstant(
-                                 loc, builder.getIndexType(),
-                                 builder.getKindMap().defaultIntegerKind())
-                           : fir::getBase(args[1]);
-
-    // Create mutable fir.box to be passed to the runtime for the result.
-    mlir::Type type = builder.getVarLenSeqTy(resultType, /*rank=*/1);
-    fir::MutableBoxValue resultMutableBox =
-        fir::factory::createTempMutableBox(builder, loc, type);
-    mlir::Value resultIrBox =
-        fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
-
-    fir::ExtendedValue box =
-        createBoxForRuntimeBoundInquiry(loc, builder, args[0]);
-    fir::runtime::genUbound(builder, loc, resultIrBox, fir::getBase(box), kind);
-
-    return readAndAddCleanUp(resultMutableBox, resultType, "UBOUND");
   }
-  return mlir::Value();
+  // Handle calls to UBOUND without the DIM argument, which return an array
+  int kindPos = args.size() == 2 ? 1 : 2;
+  return genBoundInquiry(builder, loc, resultType, args, kindPos,
+                         fir::runtime::genUbound,
+                         /*needAccurateLowerBound=*/true);
 }
 
 // SPACING
diff --git a/flang/runtime/inquiry.cpp b/flang/runtime/inquiry.cpp
index 5ffd9755fd0e5..9fbcaa96fa3c4 100644
--- a/flang/runtime/inquiry.cpp
+++ b/flang/runtime/inquiry.cpp
@@ -39,28 +39,14 @@ std::int64_t RTDEF(LboundDim)(
   return static_cast<std::int64_t>(dimension.LowerBound());
 }
 
-void RTDEF(Ubound)(Descriptor &result, const Descriptor &array, int kind,
+void RTDEF(Ubound)(void *result, const Descriptor &array, int kind,
     const char *sourceFile, int line) {
-  SubscriptValue extent[1]{array.rank()};
-  result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent,
-      CFI_attribute_allocatable);
-  // The array returned by UBOUND has a lower bound of 1 and an extent equal to
-  // the rank of its input array.
-  result.GetDimension(0).SetBounds(1, array.rank());
   Terminator terminator{sourceFile, line};
-  if (int stat{result.Allocate()}) {
-    terminator.Crash(
-        "UBOUND: could not allocate memory for result; STAT=%d", stat);
-  }
-  auto storeIntegerAt = [&](std::size_t atIndex, std::int64_t value) {
-    Fortran::runtime::ApplyIntegerKind<StoreIntegerAt, void>(
-        kind, terminator, result, atIndex, value);
-  };
-
-  INTERNAL_CHECK(result.rank() == 1);
+  INTERNAL_CHECK(array.rank() <= common::maxRank);
   for (SubscriptValue i{0}; i < array.rank(); ++i) {
     const Dimension &dimension{array.GetDimension(i)};
-    storeIntegerAt(i, dimension.UpperBound());
+    Fortran::runtime::ApplyIntegerKind<RawStoreIntegerAt, void>(
+        kind, terminator, result, i, dimension.UpperBound());
   }
 }
 
diff --git a/flang/test/Lower/HLFIR/assumed-rank-inquiries-3.f90 b/flang/test/Lower/HLFIR/assumed-rank-inquiries-3.f90
index e568b94f4f884..fb44efcad3ce7 100644
--- a/flang/test/Lower/HLFIR/assumed-rank-inquiries-3.f90
+++ b/flang/test/Lower/HLFIR/assumed-rank-inquiries-3.f90
@@ -109,3 +109,86 @@ subroutine test_lbound_2(x)
 ! CHECK:           %[[VAL_13:.*]] = fir.box_rank %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<*:f32>>>) -> index
 ! CHECK:           %[[VAL_14:.*]] = fir.shape %[[VAL_13]] : (index) -> !fir.shape<1>
 ! CHECK:           %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_12]](%[[VAL_14]]) {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>)
+
+subroutine test_ubound(x)
+  real :: x(..)
+  call takes_integer_array(ubound(x))
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_ubound(
+! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.array<15xi32>
+! CHECK:           %[[VAL_4:.*]] = arith.constant 4 : i32
+! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<15xi32>>) -> !fir.llvm_ptr<i8>
+! CHECK:           %[[VAL_8:.*]] = fir.convert %[[VAL_3:.*]] : (!fir.box<!fir.array<*:f32>>) -> !fir.box<none>
+! CHECK:           %[[VAL_10:.*]] = fir.call @_FortranAUbound(%[[VAL_7]], %[[VAL_8]], %[[VAL_4]], %{{.*}}, %{{.*}})
+! CHECK:           %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<15xi32>>) -> !fir.ref<!fir.array<?xi32>>
+! CHECK:           %[[VAL_12:.*]] = fir.box_rank %[[VAL_3]] : (!fir.box<!fir.array<*:f32>>) -> index
+! CHECK:           %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_11]](%[[VAL_13]]) {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>)
+! CHECK:           %[[VAL_15:.*]] = arith.constant false
+! CHECK:           %[[VAL_16:.*]] = hlfir.as_expr %[[VAL_14]]#0 move %[[VAL_15]] : (!fir.box<!fir.array<?xi32>>, i1) -> !hlfir.expr<?xi32>
+! CHECK:           %[[VAL_17:.*]]:3 = hlfir.associate %[[VAL_16]](%[[VAL_13]]) {adapt.valuebyref} : (!hlfir.expr<?xi32>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>, i1)
+! CHECK:           fir.call @_QPtakes_integer_array(%[[VAL_17]]#1) fastmath<contract> : (!fir.ref<!fir.array<?xi32>>) -> ()
+! CHECK:           hlfir.end_associate %[[VAL_17]]#1, %[[VAL_17]]#2 : !fir.ref<!fir.array<?xi32>>, i1
+! CHECK:           hlfir.destroy %[[VAL_16]] : !hlfir.expr<?xi32>
+! CHECK:           return
+! CHECK:         }
+
+subroutine test_ubound_kind(x)
+  real :: x(..)
+  call takes_integer8_array(ubound(x, kind=8))
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_ubound_kind(
+! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.array<15xi64>
+! CHECK:           %[[VAL_4:.*]] = arith.constant 8 : i32
+! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<15xi64>>) -> !fir.llvm_ptr<i8>
+! CHECK:           %[[VAL_8:.*]] = fir.convert %[[VAL_3:.*]] : (!fir.box<!fir.array<*:f32>>) -> !fir.box<none>
+! CHECK:           %[[VAL_10:.*]] = fir.call @_FortranAUbound(%[[VAL_7]], %[[VAL_8]], %[[VAL_4]], %{{.*}}, %{{.*}})
+! CHECK:           %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<15xi64>>) -> !fir.ref<!fir.array<?xi64>>
+! CHECK:           %[[VAL_12:.*]] = fir.box_rank %[[VAL_3]] : (!fir.box<!fir.array<*:f32>>) -> index
+! CHECK:           %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_11]](%[[VAL_13]]) {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref<!fir.array<?xi64>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi64>>, !fir.ref<!fir.array<?xi64>>)
+
+subroutine test_ubound_2(x)
+  real, pointer :: x(..)
+  call takes_integer_array(ubound(x))
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_ubound_2(
+! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.array<15xi32>
+! CHECK:           %[[VAL_4:.*]] = fir.load %[[VAL_3:.*]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>
+! CHECK:           %[[VAL_5:.*]] = arith.constant 4 : i32
+! CHECK:           %[[VAL_8:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<15xi32>>) -> !fir.llvm_ptr<i8>
+! CHECK:           %[[VAL_9:.*]] = fir.convert %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<*:f32>>>) -> !fir.box<none>
+! CHECK:           %[[VAL_11:.*]] = fir.call @_FortranAUbound(%[[VAL_8]], %[[VAL_9]], %[[VAL_5]], %{{.*}}, %{{.*}})
+! CHECK:           %[[VAL_12:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<15xi32>>) -> !fir.ref<!fir.array<?xi32>>
+! CHECK:           %[[VAL_13:.*]] = fir.box_rank %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<*:f32>>>) -> index
+! CHECK:           %[[VAL_14:.*]] = fir.shape %[[VAL_13]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_12]](%[[VAL_14]]) {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>)
+
+subroutine test_lbound_dim(x)
+  real :: x(..)
+  call takes_integer(lbound(x, dim=2))
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_lbound_dim(
+! CHECK:           %[[VAL_3:.*]] = arith.constant 2 : i32
+! CHECK:           %[[VAL_6:.*]] = fir.convert %[[VAL_2:.*]]#0 : (!fir.box<!fir.array<*:f32>>) -> !fir.box<none>
+! CHECK:           %[[VAL_8:.*]] = fir.call @_FortranALboundDim(%[[VAL_6]], %[[VAL_3]],
+! CHECK:           %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> i32
+! CHECK:           %[[VAL_10:.*]]:3 = hlfir.associate %[[VAL_9]]
+
+
+subroutine test_ubound_dim(x)
+  real :: x(..)
+  call takes_integer(ubound(x, dim=2))
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_ubound_dim(
+! CHECK:           %[[VAL_3:.*]] = arith.constant 2 : i32
+! CHECK:           %[[VAL_6:.*]] = fir.convert %[[VAL_2:.*]]#0 : (!fir.box<!fir.array<*:f32>>) -> !fir.box<none>
+! CHECK:           %[[VAL_8:.*]] = fir.call @_FortranASizeDim(%[[VAL_6]], %[[VAL_3]],
+! CHECK:           %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> i32
+! CHECK:           %[[VAL_12:.*]] = fir.convert %[[VAL_2]]#0 : (!fir.box<!fir.array<*:f32>>) -> !fir.box<none>
+! CHECK:           %[[VAL_14:.*]] = fir.call @_FortranALboundDim(%[[VAL_12]], %[[VAL_3]],
+! CHECK:           %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i64) -> i32
+! CHECK:           %[[VAL_16:.*]] = arith.constant 1 : i32
+! CHECK:           %[[VAL_17:.*]] = arith.subi %[[VAL_15]], %[[VAL_16]] : i32
+! CHECK:           %[[VAL_18:.*]] = arith.addi %[[VAL_17]], %[[VAL_9]] : i32
+! CHECK:           %[[VAL_19:.*]]:3 = hlfir.associate %[[VAL_18]]
diff --git a/flang/test/Lower/Intrinsics/ubound01.f90 b/flang/test/Lower/Intrinsics/ubound01.f90
index df51d79eb6afe..e933075cc0bf2 100644
--- a/flang/test/Lower/Intrinsics/ubound01.f90
+++ b/flang/test/Lower/Intrinsics/ubound01.f90
@@ -20,4 +20,4 @@ subroutine s2(a,n,n2)
 ! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?x?xf32>>
 ! CHECK: %[[BOX:.*]] = fir.rebox %[[ARG0]](%{{.*}}) : (!fir.box<!fir.array<?x?xf32>>, !fir.shift<2>) -> !fir.box<!fir.array<?x?xf32>>
 ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box<!fir.array<?x?xf32>>) -> !fir.box<none>
-! CHECK: %{{.*}} = fir.call @_FortranAUbound(%{{.*}}, %[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i32, !fir.ref<i8>, i32) -> none
+! CHECK: %{{.*}} = fir.call @_FortranAUbound(%{{.*}}, %[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.llvm_ptr<i8>, !fir.box<none>, i32, !fir.ref<i8>, i32) -> none
diff --git a/flang/unittests/Runtime/Inquiry.cpp b/flang/unittests/Runtime/Inquiry.cpp
index 98a350d3ad98a..3b523e992a317 100644
--- a/flang/unittests/Runtime/Inquiry.cpp
+++ b/flang/unittests/Runtime/Inquiry.cpp
@@ -69,35 +69,33 @@ TEST(Inquiry, Ubound) {
       std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
   array->GetDimension(0).SetLowerBound(1000);
   array->GetDimension(1).SetLowerBound(1);
-  StaticDescriptor<2, true> statDesc;
-
-  int intValue{1};
-  SubscriptValue extent[]{2};
-  Descriptor &result{statDesc.descriptor()};
-  result.Establish(TypeCategory::Integer, /*KIND=*/4,
-      static_cast<void *>(&intValue), 1, extent, CFI_attribute_pointer);
-  RTNAME(Ubound)(result, *array, /*KIND=*/4, __FILE__, __LINE__);
-  EXPECT_EQ(result.rank(), 1);
-  EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Integer, 4}.raw()));
-  // The lower bound of UBOUND's result array is always 1
-  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
-  EXPECT_EQ(result.GetDimension(0).Extent(), 2);
-  EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(0), 1001);
-  EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(1), 3);
-  result.Destroy();
-
-  result = statDesc.descriptor();
-  result.Establish(TypeCategory::Integer, /*KIND=*/1,
-      static_cast<void *>(&intValue), 1, extent, CFI_attribute_pointer);
-  RTNAME(Ubound)(result, *array, /*KIND=*/1, __FILE__, __LINE__);
-  EXPECT_EQ(result.rank(), 1);
-  EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Integer, 1}.raw()));
-  // The lower bound of UBOUND's result array is always 1
-  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
-  EXPECT_EQ(result.GetDimension(0).Extent(), 2);
-  EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int8_t>(0), -23);
-  EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int8_t>(1), 3);
-  result.Destroy();
+
+  // UBOUND(ARRAY, KIND=1)
+  auto int8Result{
+      MakeArray<TypeCategory::Integer, 1>(std::vector<int>{array->rank()},
+          std::vector<std::int8_t>(array->rank(), 0))};
+  RTNAME(Ubound)
+  (int8Result->raw().base_addr, *array, /*KIND=*/1, __FILE__, __LINE__);
+  EXPECT_EQ(*int8Result->ZeroBasedIndexedElement<std::int8_t>(0), -23);
+  EXPECT_EQ(*int8Result->ZeroBasedIndexedElement<std::int8_t>(1), 3);
+
+  // UBOUND(ARRAY, KIND=4)
+  auto int32Result{
+      MakeArray<TypeCategory::Integer, 4>(std::vector<int>{array->rank()},
+          std::vector<std::int32_t>(array->rank(), 0))};
+  RTNAME(Ubound)
+  (int32Result->raw().base_addr, *array, /*KIND=*/4, __FILE__, __LINE__);
+  EXPECT_EQ(*int32Result->ZeroBasedIndexedElement<std::int32_t>(0), 1001);
+  EXPECT_EQ(*int32Result->ZeroBasedIndexedElement<std::int32_t>(1), 3);
+
+  // UBOUND(ARRAY, KIND=8)
+  auto int64Result{
+      MakeArray<TypeCategory::Integer, 8>(std::vector<int>{array->rank()},
+          std::vector<std::int64_t>(array->rank(), 0))};
+  RTNAME(Ubound)
+  (int64Result->raw().base_addr, *array, /*KIND=*/8, __FILE__, __LINE__);
+  EXPECT_EQ(*int64Result->ZeroBasedIndexedElement<std::int64_t>(0), 1001);
+  EXPECT_EQ(*int64Result->ZeroBasedIndexedElement<std::int64_t>(1), 3);
 }
 
 TEST(Inquiry, Size) {

>From 4d661369c362e3d73780b77378de692f89b84f68 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 12 Jun 2024 00:27:56 -0700
Subject: [PATCH 2/2] compute kindPos according to number of arguments

---
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index c4e946a5d25c9..ce53521e159c1 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -6386,10 +6386,12 @@ IntrinsicLibrary::genLbound(mlir::Type resultType,
   // Semantics builds signatures for LBOUND calls as either
   // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]).
   const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1);
-  if (array.hasAssumedRank() && dimIsAbsent)
-    return genBoundInquiry(builder, loc, resultType, args,
-                           /*kindPos=*/1, fir::runtime::genLbound,
+  if (array.hasAssumedRank() && dimIsAbsent) {
+    int kindPos = args.size() == 2 ? 1 : 2;
+    return genBoundInquiry(builder, loc, resultType, args, kindPos,
+                           fir::runtime::genLbound,
                            /*needAccurateLowerBound=*/true);
+  }
 
   mlir::Type indexType = builder.getIndexType();
 



More information about the flang-commits mailing list