[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

diff --git a/flang/include/flang/Runtime/inquiry.h b/flang/include/flang/Runtime/inquiry.h
new file mode 100644 (file)
index 0000000..8d67363
--- /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 e3e9ee9..6a80b65 100644 (file)
--- 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 (file)
index 0000000..1f67020
--- /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 f7ef5be..83ba370 100644 (file)
--- 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 3e0a68b..3bc1e07 100644 (file)
--- 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 5985adf..370f13d 100644 (file)
--- 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 (file)
index 0000000..5794417
--- /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});
+}