folding.cpp
4.09 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
#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();
}