From 6cd417bfd886ffe4e0cf4b48055aa7bfc352b789 Mon Sep 17 00:00:00 2001 From: Peter Steinfeld Date: Wed, 9 Feb 2022 11:17:18 -0800 Subject: [PATCH] [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 --- flang/include/flang/Runtime/inquiry.h | 35 +++++++++++++++ flang/runtime/CMakeLists.txt | 1 + flang/runtime/inquiry.cpp | 78 ++++++++++++++++++++++++++++++++++ flang/runtime/time-intrinsic.cpp | 13 +----- flang/runtime/tools.h | 9 ++++ flang/unittests/Runtime/CMakeLists.txt | 1 + flang/unittests/Runtime/Inquiry.cpp | 78 ++++++++++++++++++++++++++++++++++ 7 files changed, 204 insertions(+), 11 deletions(-) create mode 100644 flang/include/flang/Runtime/inquiry.h create mode 100644 flang/runtime/inquiry.cpp create mode 100644 flang/unittests/Runtime/Inquiry.cpp diff --git a/flang/include/flang/Runtime/inquiry.h b/flang/include/flang/Runtime/inquiry.h new file mode 100644 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 + +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 --- 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 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 + +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(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( + 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(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 --- 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 struct StoreIntegerAt { - void operator()(const Fortran::runtime::Descriptor &result, std::size_t at, - std::int64_t value) const { - *result.ZeroBasedIndexedElement>(at) = value; - } -}; - // Helper to set an integer value to -HUGE template 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( - kind, terminator, *values, atIndex, value); + Fortran::runtime::ApplyIntegerKind(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 --- 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 struct StoreIntegerAt { + void operator()(const Fortran::runtime::Descriptor &result, std::size_t at, + std::int64_t value) const { + *result.ZeroBasedIndexedElement>(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..370f13dc 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 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( + std::vector{2, 3}, std::vector{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( + std::vector{2, 3}, std::vector{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(&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(0), 1001); + EXPECT_EQ(*result.ZeroBasedIndexedElement(1), 3); + result.Destroy(); + + result = statDesc.descriptor(); + result.Establish(TypeCategory::Integer, /*KIND=*/1, + static_cast(&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(0), -23); + EXPECT_EQ(*result.ZeroBasedIndexedElement(1), 3); + result.Destroy(); +} + +TEST(Inquiry, Size) { + // ARRAY 1 3 5 + // 2 4 6 + auto array{MakeArray( + std::vector{2, 3}, std::vector{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}); +} -- 2.7.4