[flang] Upstream runtime changes for inquiry intrinsics

[PeteSteinfeld]

Summary

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.

[klausler]

flang/include/flang/Runtime/inquiry.h

26

"array" would be a more descriptive name for the second argument than "descriptor".

flang/runtime/inquiry.cpp

59

Since the function returns std::int64_t, that should also be the type of "result".

[PeteSteinfeld]

flang/include/flang/Runtime/inquiry.h

26

Thanks. I'll change it.

flang/runtime/inquiry.cpp

59

Good catch. I'll change it.

flang/include/flang/Runtime/inquiry.h

+//===-- 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 &descriptor, 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_

flang/runtime/CMakeLists.txt

add_flang_library(FortranRuntime
   edit-input.cpp
   edit-output.cpp
   environment.cpp
   extensions.cpp
   extrema.cpp
   file.cpp
   findloc.cpp
   format.cpp
+  inquiry.cpp
   internal-unit.cpp
   iostat.cpp
   io-api.cpp
   io-error.cpp
   io-stmt.cpp
   main.cpp
   matmul.cpp
   memory.cpp

flang/runtime/inquiry.cpp

+//===-- 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) {
+  SubscriptValue 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

flang/runtime/time-intrinsic.cpp

count_t GetSystemClockCountMax(int kind, preferred_implementation,
   unsigned_count_t maxClockNsec{maxSecs * NSECS_PER_SEC + NSECS_PER_SEC - 1};
   unsigned_count_t maxClock{ScaleResult(maxClockNsec, kind)};
   unsigned_count_t maxCount{GetHUGE(kind)};
   return static_cast<count_t>(maxClock <= maxCount ? maxClock : maxCount);
 }
 
 // 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()(
       const Fortran::runtime::Descriptor &result, std::size_t at) const {
     *result.ZeroBasedIndexedElement<Fortran::runtime::CppTypeFor<
         Fortran::common::TypeCategory::Integer, KIND>>(at) =
         -std::numeric_limits<Fortran::runtime::CppTypeFor<
             Fortran::common::TypeCategory::Integer, KIND>>::max();
RUNTIME_CHECK(terminator,
         values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&
             typeCode &&
             typeCode->first == Fortran::common::TypeCategory::Integer);
     // DATE_AND_TIME values argument must have decimal range > 4. Do not accept
     // KIND 1 here.
     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);
     storeIntegerAt(2, localTime.tm_mday);
     Fortran::runtime::ApplyIntegerKind<
         GmtOffsetHelper<struct tm>::StoreGmtOffset, void>(
         kind, terminator, *values, 3, localTime);
     storeIntegerAt(4, localTime.tm_hour);

flang/runtime/tools.h

inline bool IsLogicalElementTrue(
   return false;
 }
 
 // Check array conformability; a scalar 'x' conforms.  Crashes on error.
 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);
 
 template <typename TO, typename FROM>
 inline void PutContiguousConverted(TO *to, FROM *from, std::size_t count) {
   while (count-- > 0) {
     *to++ = *from++;
   }

flang/unittests/Runtime/CMakeLists.txt

 add_flang_unittest(FlangRuntimeTests
   BufferTest.cpp
   CharacterTest.cpp
   CommandTest.cpp
   CrashHandlerFixture.cpp
   ExternalIOTest.cpp
   Format.cpp
+  Inquiry.cpp
   ListInputTest.cpp
   Matmul.cpp
   MiscIntrinsic.cpp
   Namelist.cpp
   Numeric.cpp
   NumericalFormatTest.cpp
   Ragged.cpp
   Random.cpp

flang/unittests/Runtime/Inquiry.cpp

+//===-- 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});
+}