[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
This commit is contained in:
parent
9582f09690
commit
6cd417bfd8
35
flang/include/flang/Runtime/inquiry.h
Normal file
35
flang/include/flang/Runtime/inquiry.h
Normal file
|
@ -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_
|
|
@ -53,6 +53,7 @@ add_flang_library(FortranRuntime
|
|||
file.cpp
|
||||
findloc.cpp
|
||||
format.cpp
|
||||
inquiry.cpp
|
||||
internal-unit.cpp
|
||||
iostat.cpp
|
||||
io-api.cpp
|
||||
|
|
78
flang/runtime/inquiry.cpp
Normal file
78
flang/runtime/inquiry.cpp
Normal file
|
@ -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
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -5,6 +5,7 @@ add_flang_unittest(FlangRuntimeTests
|
|||
CrashHandlerFixture.cpp
|
||||
ExternalIOTest.cpp
|
||||
Format.cpp
|
||||
Inquiry.cpp
|
||||
ListInputTest.cpp
|
||||
Matmul.cpp
|
||||
MiscIntrinsic.cpp
|
||||
|
|
78
flang/unittests/Runtime/Inquiry.cpp
Normal file
78
flang/unittests/Runtime/Inquiry.cpp
Normal file
|
@ -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});
|
||||
}
|
Loading…
Reference in a new issue