[flang-commits] [flang] 6cd417b - [flang] Upstream runtime changes for inquiry intrinsics
Peter Steinfeld via flang-commits
flang-commits at lists.llvm.org
Wed Feb 9 12:42:59 PST 2022
Author: Peter Steinfeld
Date: 2022-02-09T12:42:36-08:00
New Revision: 6cd417bfd886ffe4e0cf4b48055aa7bfc352b789
URL: https://github.com/llvm/llvm-project/commit/6cd417bfd886ffe4e0cf4b48055aa7bfc352b789
DIFF: https://github.com/llvm/llvm-project/commit/6cd417bfd886ffe4e0cf4b48055aa7bfc352b789.diff
LOG: [flang] Upstream runtime changes for inquiry intrinsics
This change adds runtime routines and tests for LBOUND when passed a DIM argument, SIZE, and UBOUND when not passed a DIM argument.
Associated changes for lowering have already been merged into fir-dev.
Differential Revision: https://reviews.llvm.org/D119360
Added:
flang/include/flang/Runtime/inquiry.h
flang/runtime/inquiry.cpp
flang/unittests/Runtime/Inquiry.cpp
Modified:
flang/runtime/CMakeLists.txt
flang/runtime/time-intrinsic.cpp
flang/runtime/tools.h
flang/unittests/Runtime/CMakeLists.txt
Removed:
################################################################################
diff --git a/flang/include/flang/Runtime/inquiry.h b/flang/include/flang/Runtime/inquiry.h
new file mode 100644
index 0000000000000..8d673637b3009
--- /dev/null
+++ b/flang/include/flang/Runtime/inquiry.h
@@ -0,0 +1,35 @@
+//===-- include/flang/Runtime/inquiry.h ----------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// Defines the API for the inquiry intrinsic functions
+// that inquire about shape information in arrays: LBOUND and SIZE.
+
+#ifndef FORTRAN_RUNTIME_INQUIRY_H_
+#define FORTRAN_RUNTIME_INQUIRY_H_
+
+#include "flang/Runtime/entry-names.h"
+#include <cinttypes>
+
+namespace Fortran::runtime {
+
+class Descriptor;
+
+extern "C" {
+
+std::int64_t RTNAME(LboundDim)(const Descriptor &array, int dim,
+ const char *sourceFile = nullptr, int line = 0);
+void RTNAME(Ubound)(Descriptor &result, const Descriptor &array, int kind,
+ const char *sourceFile = nullptr, int line = 0);
+std::int64_t RTNAME(Size)(
+ const Descriptor &array, const char *sourceFile = nullptr, int line = 0);
+std::int64_t RTNAME(SizeDim)(const Descriptor &array, int dim,
+ const char *sourceFile = nullptr, int line = 0);
+
+} // extern "C"
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_INQUIRY_H_
diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt
index e3e9ee982b10d..6a80b65ba0342 100644
--- a/flang/runtime/CMakeLists.txt
+++ b/flang/runtime/CMakeLists.txt
@@ -53,6 +53,7 @@ add_flang_library(FortranRuntime
file.cpp
findloc.cpp
format.cpp
+ inquiry.cpp
internal-unit.cpp
iostat.cpp
io-api.cpp
diff --git a/flang/runtime/inquiry.cpp b/flang/runtime/inquiry.cpp
new file mode 100644
index 0000000000000..1f67020f2cafd
--- /dev/null
+++ b/flang/runtime/inquiry.cpp
@@ -0,0 +1,78 @@
+//===-- runtime/inquiry.cpp --------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// Implements the inquiry intrinsic functions of Fortran 2018 that
+// inquire about shape information of arrays -- LBOUND and SIZE.
+
+#include "flang/Runtime/inquiry.h"
+#include "copy.h"
+#include "terminator.h"
+#include "tools.h"
+#include "flang/Runtime/descriptor.h"
+#include <algorithm>
+
+namespace Fortran::runtime {
+
+extern "C" {
+std::int64_t RTNAME(LboundDim)(
+ const Descriptor &array, int dim, const char *sourceFile, int line) {
+ if (dim < 1 || dim > array.rank()) {
+ Terminator terminator{sourceFile, line};
+ terminator.Crash("SIZE: bad DIM=%d", dim);
+ }
+ const Dimension &dimension{array.GetDimension(dim - 1)};
+ return static_cast<std::int64_t>(dimension.LowerBound());
+}
+
+void RTNAME(Ubound)(Descriptor &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);
+ for (SubscriptValue i{0}; i < array.rank(); ++i) {
+ const Dimension &dimension{array.GetDimension(i)};
+ storeIntegerAt(i, dimension.UpperBound());
+ }
+}
+
+std::int64_t RTNAME(Size)(
+ const Descriptor &array, const char *sourceFile, int line) {
+ std::int64_t result{1};
+ for (int i = 0; i < array.rank(); ++i) {
+ const Dimension &dimension{array.GetDimension(i)};
+ result *= dimension.Extent();
+ }
+ return result;
+}
+
+std::int64_t RTNAME(SizeDim)(
+ const Descriptor &array, int dim, const char *sourceFile, int line) {
+ if (dim < 1 || dim > array.rank()) {
+ Terminator terminator{sourceFile, line};
+ terminator.Crash("SIZE: bad DIM=%d", dim);
+ }
+ const Dimension &dimension{array.GetDimension(dim - 1)};
+ return static_cast<std::int64_t>(dimension.Extent());
+}
+
+} // extern "C"
+} // namespace Fortran::runtime
diff --git a/flang/runtime/time-intrinsic.cpp b/flang/runtime/time-intrinsic.cpp
index f7ef5be23e26f..83ba370c0a7d3 100644
--- a/flang/runtime/time-intrinsic.cpp
+++ b/flang/runtime/time-intrinsic.cpp
@@ -182,15 +182,6 @@ count_t GetSystemClockCountMax(int kind, preferred_implementation,
// DATE_AND_TIME (Fortran 2018 16.9.59)
-// Helper to store integer value in result[at].
-template <int KIND> struct StoreIntegerAt {
- void operator()(const Fortran::runtime::Descriptor &result, std::size_t at,
- std::int64_t value) const {
- *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
- Fortran::common::TypeCategory::Integer, KIND>>(at) = value;
- }
-};
-
// Helper to set an integer value to -HUGE
template <int KIND> struct StoreNegativeHugeAt {
void operator()(
@@ -319,8 +310,8 @@ static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,
int kind{typeCode->second};
RUNTIME_CHECK(terminator, kind != 1);
auto storeIntegerAt = [&](std::size_t atIndex, std::int64_t value) {
- Fortran::runtime::ApplyIntegerKind<StoreIntegerAt, void>(
- kind, terminator, *values, atIndex, value);
+ Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt,
+ void>(kind, terminator, *values, atIndex, value);
};
storeIntegerAt(0, localTime.tm_year + 1900);
storeIntegerAt(1, localTime.tm_mon + 1);
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index 3e0a68b180172..3bc1e0755ce5a 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -56,6 +56,15 @@ void CheckConformability(const Descriptor &to, const Descriptor &x,
Terminator &, const char *funcName, const char *toName,
const char *fromName);
+// Helper to store integer value in result[at].
+template <int KIND> struct StoreIntegerAt {
+ void operator()(const Fortran::runtime::Descriptor &result, std::size_t at,
+ std::int64_t value) const {
+ *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
+ Fortran::common::TypeCategory::Integer, KIND>>(at) = value;
+ }
+};
+
// Validate a KIND= argument
void CheckIntegerKind(Terminator &, int kind, const char *intrinsic);
diff --git a/flang/unittests/Runtime/CMakeLists.txt b/flang/unittests/Runtime/CMakeLists.txt
index 5985adf391850..370f13dc6de76 100644
--- a/flang/unittests/Runtime/CMakeLists.txt
+++ b/flang/unittests/Runtime/CMakeLists.txt
@@ -5,6 +5,7 @@ add_flang_unittest(FlangRuntimeTests
CrashHandlerFixture.cpp
ExternalIOTest.cpp
Format.cpp
+ Inquiry.cpp
ListInputTest.cpp
Matmul.cpp
MiscIntrinsic.cpp
diff --git a/flang/unittests/Runtime/Inquiry.cpp b/flang/unittests/Runtime/Inquiry.cpp
new file mode 100644
index 0000000000000..57944174cb245
--- /dev/null
+++ b/flang/unittests/Runtime/Inquiry.cpp
@@ -0,0 +1,78 @@
+//===-- flang/unittests/RuntimeGTest/Inquiry.cpp -----------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Runtime/inquiry.h"
+#include "gtest/gtest.h"
+#include "tools.h"
+#include "flang/Runtime/type-code.h"
+
+using namespace Fortran::runtime;
+using Fortran::common::TypeCategory;
+
+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);
+
+ EXPECT_EQ(RTNAME(LboundDim)(*array, 1, __FILE__, __LINE__), std::int64_t{0});
+ EXPECT_EQ(RTNAME(LboundDim)(*array, 2, __FILE__, __LINE__), std::int64_t{-1});
+}
+
+TEST(Inquiry, Ubound) {
+ // 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(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();
+}
+
+TEST(Inquiry, Size) {
+ // 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); // shouldn't matter
+ array->GetDimension(1).SetLowerBound(-1);
+
+ EXPECT_EQ(RTNAME(SizeDim)(*array, 1, __FILE__, __LINE__), std::int64_t{2});
+ EXPECT_EQ(RTNAME(SizeDim)(*array, 2, __FILE__, __LINE__), std::int64_t{3});
+ EXPECT_EQ(RTNAME(Size)(*array, __FILE__, __LINE__), std::int64_t{6});
+}
More information about the flang-commits
mailing list