squiid/llvm
1
0
Fork 0
Code Issues Pull requests Activity

[flang] Upstream runtime changes for inquiry intrinsics

Browse source 
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:
Peter Steinfeld 2022-02-09 11:17:18 -08:00
parent 9582f09690
commit 6cd417bfd8
7 changed files with 204 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
flang/include/flang/Runtime/inquiry.h Normal file
View 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_

1
flang/runtime/CMakeLists.txt
View file

@ -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
View 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

13
flang/runtime/time-intrinsic.cpp
View file

@ -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);

9
flang/runtime/tools.h
View file

@ -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);

1
flang/unittests/Runtime/CMakeLists.txt
View file

@ -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
View 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});
}