forked from OSchip/llvm-project
110 lines
4.1 KiB
C++
110 lines
4.1 KiB
C++
#include "testing.h"
|
|
#include "../../lib/Evaluate/host.h"
|
|
#include "../../lib/Evaluate/intrinsics-library-templates.h"
|
|
#include "flang/Evaluate/call.h"
|
|
#include "flang/Evaluate/expression.h"
|
|
#include "flang/Evaluate/fold.h"
|
|
#include "flang/Evaluate/intrinsics.h"
|
|
#include "flang/Evaluate/tools.h"
|
|
#include <tuple>
|
|
|
|
using namespace Fortran::evaluate;
|
|
|
|
// helper to call functions on all types from tuple
|
|
template <typename... T> struct RunOnTypes {};
|
|
template <typename Test, typename... T>
|
|
struct RunOnTypes<Test, std::tuple<T...>> {
|
|
static void Run() { (..., Test::template Run<T>()); }
|
|
};
|
|
|
|
// test for fold.h GetScalarConstantValue function
|
|
struct TestGetScalarConstantValue {
|
|
template <typename T> static void Run() {
|
|
Expr<T> exprFullyTyped{Constant<T>{Scalar<T>{}}};
|
|
Expr<SomeKind<T::category>> exprSomeKind{exprFullyTyped};
|
|
Expr<SomeType> exprSomeType{exprSomeKind};
|
|
TEST(GetScalarConstantValue<T>(exprFullyTyped).has_value());
|
|
TEST(GetScalarConstantValue<T>(exprSomeKind).has_value());
|
|
TEST(GetScalarConstantValue<T>(exprSomeType).has_value());
|
|
}
|
|
};
|
|
|
|
template <typename T>
|
|
static FunctionRef<T> CreateIntrinsicElementalCall(
|
|
const std::string &name, const Expr<T> &arg) {
|
|
Fortran::semantics::Attrs attrs;
|
|
attrs.set(Fortran::semantics::Attr::ELEMENTAL);
|
|
ActualArguments args{ActualArgument{AsGenericExpr(arg)}};
|
|
ProcedureDesignator intrinsic{
|
|
SpecificIntrinsic{name, T::GetType(), 0, attrs}};
|
|
return FunctionRef<T>{std::move(intrinsic), std::move(args)};
|
|
}
|
|
|
|
// Test flushSubnormalsToZero when folding with host runtime.
|
|
// Subnormal value flushing on host is handle in host.cpp
|
|
// HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment
|
|
|
|
// Dummy host runtime functions where subnormal flushing matters
|
|
float SubnormalFlusher1(float f) { // given f is subnormal
|
|
return 2.3 * f; // returns 0 if subnormal arguments are flushed to zero
|
|
}
|
|
|
|
float SubnormalFlusher2(float f) { // given f/2 is subnormal
|
|
return f / 2.3; // returns 0 if subnormal
|
|
}
|
|
|
|
void TestHostRuntimeSubnormalFlushing() {
|
|
using R4 = Type<TypeCategory::Real, 4>;
|
|
if constexpr (std::is_same_v<host::HostType<R4>, float>) {
|
|
Fortran::parser::CharBlock src;
|
|
Fortran::parser::ContextualMessages messages{src, nullptr};
|
|
Fortran::common::IntrinsicTypeDefaultKinds defaults;
|
|
auto intrinsics{Fortran::evaluate::IntrinsicProcTable::Configure(defaults)};
|
|
FoldingContext flushingContext{
|
|
messages, defaults, intrinsics, defaultRounding, true};
|
|
FoldingContext noFlushingContext{
|
|
messages, defaults, intrinsics, defaultRounding, false};
|
|
|
|
HostIntrinsicProceduresLibrary lib;
|
|
lib.AddProcedure(HostRuntimeIntrinsicProcedure{
|
|
"flusher_test1", SubnormalFlusher1, true});
|
|
lib.AddProcedure(HostRuntimeIntrinsicProcedure{
|
|
"flusher_test2", SubnormalFlusher2, true});
|
|
|
|
// Test subnormal argument flushing
|
|
if (auto callable{
|
|
lib.GetHostProcedureWrapper<Scalar, R4, R4>("flusher_test1")}) {
|
|
// Biggest IEEE 32bits subnormal power of two
|
|
host::HostType<R4> input1{5.87747175411144e-39};
|
|
const Scalar<R4> x1{host::CastHostToFortran<R4>(input1)};
|
|
Scalar<R4> y1Flushing{callable.value()(flushingContext, x1)};
|
|
Scalar<R4> y1NoFlushing{callable.value()(noFlushingContext, x1)};
|
|
TEST(y1Flushing.IsZero());
|
|
TEST(!y1NoFlushing.IsZero());
|
|
} else {
|
|
TEST(false);
|
|
}
|
|
// Test subnormal result flushing
|
|
if (auto callable{
|
|
lib.GetHostProcedureWrapper<Scalar, R4, R4>("flusher_test2")}) {
|
|
// Smallest (positive) non-subnormal IEEE 32 bit float value
|
|
host::HostType<R4> input2{1.1754944e-38};
|
|
const Scalar<R4> x2{host::CastHostToFortran<R4>(input2)};
|
|
Scalar<R4> y2Flushing{callable.value()(flushingContext, x2)};
|
|
Scalar<R4> y2NoFlushing{callable.value()(noFlushingContext, x2)};
|
|
TEST(y2Flushing.IsZero());
|
|
TEST(!y2NoFlushing.IsZero());
|
|
} else {
|
|
TEST(false);
|
|
}
|
|
} else {
|
|
TEST(false); // Cannot run this test on the host
|
|
}
|
|
}
|
|
|
|
int main() {
|
|
RunOnTypes<TestGetScalarConstantValue, AllIntrinsicTypes>::Run();
|
|
TestHostRuntimeSubnormalFlushing();
|
|
return testing::Complete();
|
|
}
|