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
--- /dev/null
+//===-- 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_
file.cpp
findloc.cpp
format.cpp
+ inquiry.cpp
internal-unit.cpp
iostat.cpp
io-api.cpp
--- /dev/null
+//===-- 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
// 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()(
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);
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);
CrashHandlerFixture.cpp
ExternalIOTest.cpp
Format.cpp
+ Inquiry.cpp
ListInputTest.cpp
Matmul.cpp
MiscIntrinsic.cpp
--- /dev/null
+//===-- 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});
+}