[flang-commits] [flang] [flang][runtime] add LBOUND API for assumed-rank arrays (PR #94808)
via flang-commits
flang-commits at lists.llvm.org
Mon Jun 10 01:12:51 PDT 2024
https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/94808
>From 10f25edae251d1e834b1283ca23f02a375c7f60b Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Fri, 7 Jun 2024 14:46:27 -0700
Subject: [PATCH] [flang][runtime] add LBOUND API for assumed-rank arrays
---
flang/include/flang/Runtime/inquiry.h | 3 +++
flang/runtime/inquiry.cpp | 11 ++++++++
flang/unittests/Runtime/Inquiry.cpp | 38 ++++++++++++++++++++++++++-
3 files changed, 51 insertions(+), 1 deletion(-)
diff --git a/flang/include/flang/Runtime/inquiry.h b/flang/include/flang/Runtime/inquiry.h
index 7161d1e41c4bb..3c53347132688 100644
--- a/flang/include/flang/Runtime/inquiry.h
+++ b/flang/include/flang/Runtime/inquiry.h
@@ -24,6 +24,9 @@ extern "C" {
std::int64_t RTDECL(LboundDim)(const Descriptor &array, int dim,
const char *sourceFile = nullptr, int line = 0);
+void RTDECL(Lbound)(void *result, const Descriptor &array, int kind,
+ const char *sourceFile = nullptr, int line = 0);
+
void RTDECL(Shape)(void *result, const Descriptor &array, int kind);
std::int64_t RTDECL(Size)(
diff --git a/flang/runtime/inquiry.cpp b/flang/runtime/inquiry.cpp
index ea114174de7fd..faf0f0baa005c 100644
--- a/flang/runtime/inquiry.cpp
+++ b/flang/runtime/inquiry.cpp
@@ -95,5 +95,16 @@ void RTDEF(Shape)(void *result, const Descriptor &array, int kind) {
}
}
+void RTDEF(Lbound)(void *result, const Descriptor &array, int kind,
+ const char *sourceFile, int line) {
+ Terminator terminator{sourceFile, line};
+ INTERNAL_CHECK(array.rank() <= common::maxRank);
+ for (SubscriptValue i{0}; i < array.rank(); ++i) {
+ const Dimension &dimension{array.GetDimension(i)};
+ Fortran::runtime::ApplyIntegerKind<RawStoreIntegerAt, void>(
+ kind, terminator, result, i, dimension.LowerBound());
+ }
+}
+
} // extern "C"
} // namespace Fortran::runtime
diff --git a/flang/unittests/Runtime/Inquiry.cpp b/flang/unittests/Runtime/Inquiry.cpp
index 665a930ee4ff9..53672295f96ba 100644
--- a/flang/unittests/Runtime/Inquiry.cpp
+++ b/flang/unittests/Runtime/Inquiry.cpp
@@ -14,7 +14,7 @@
using namespace Fortran::runtime;
using Fortran::common::TypeCategory;
-TEST(Inquiry, Lbound) {
+TEST(Inquiry, LboundDim) {
// ARRAY 1 3 5
// 2 4 6
auto array{MakeArray<TypeCategory::Integer, 4>(
@@ -26,6 +26,42 @@ TEST(Inquiry, Lbound) {
EXPECT_EQ(RTNAME(LboundDim)(*array, 2, __FILE__, __LINE__), std::int64_t{-1});
}
+TEST(Inquiry, Lbound) {
+ // ARRAY 1 3 5
+ // 2 4 6
+ auto array{MakeArray<TypeCategory::Integer, 4>(
+ std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
+ array->GetDimension(0).SetLowerBound(0);
+ array->GetDimension(1).SetLowerBound(-1);
+
+ // LBOUND(ARRAY, KIND=1)
+ auto int8Result{
+ MakeArray<TypeCategory::Integer, 1>(std::vector<int>{array->rank()},
+ std::vector<std::int8_t>(array->rank(), 0))};
+ RTNAME(Lbound)
+ (int8Result->raw().base_addr, *array, /*KIND=*/1, __FILE__, __LINE__);
+ EXPECT_EQ(*int8Result->ZeroBasedIndexedElement<std::int8_t>(0), 0);
+ EXPECT_EQ(*int8Result->ZeroBasedIndexedElement<std::int8_t>(1), -1);
+
+ // LBOUND(ARRAY, KIND=4)
+ auto int32Result{
+ MakeArray<TypeCategory::Integer, 4>(std::vector<int>{array->rank()},
+ std::vector<std::int32_t>(array->rank(), 0))};
+ RTNAME(Lbound)
+ (int32Result->raw().base_addr, *array, /*KIND=*/4, __FILE__, __LINE__);
+ EXPECT_EQ(*int32Result->ZeroBasedIndexedElement<std::int32_t>(0), 0);
+ EXPECT_EQ(*int32Result->ZeroBasedIndexedElement<std::int32_t>(1), -1);
+
+ // LBOUND(ARRAY, KIND=8)
+ auto int64Result{
+ MakeArray<TypeCategory::Integer, 8>(std::vector<int>{array->rank()},
+ std::vector<std::int64_t>(array->rank(), 0))};
+ RTNAME(Lbound)
+ (int64Result->raw().base_addr, *array, /*KIND=*/8, __FILE__, __LINE__);
+ EXPECT_EQ(*int64Result->ZeroBasedIndexedElement<std::int64_t>(0), 0);
+ EXPECT_EQ(*int64Result->ZeroBasedIndexedElement<std::int64_t>(1), -1);
+}
+
TEST(Inquiry, Ubound) {
// ARRAY 1 3 5
// 2 4 6
More information about the flang-commits
mailing list