You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
80 lines
3.0 KiB
80 lines
3.0 KiB
#include "testing.h"
|
|
#include "../../lib/Evaluate/host.h"
|
|
#include "flang/Evaluate/call.h"
|
|
#include "flang/Evaluate/expression.h"
|
|
#include "flang/Evaluate/fold.h"
|
|
#include "flang/Evaluate/intrinsics-library.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>
|
|
Scalar<T> CallHostRt(
|
|
HostRuntimeWrapper func, FoldingContext &context, Scalar<T> x) {
|
|
return GetScalarConstantValue<T>(
|
|
func(context, {AsGenericExpr(Constant<T>{x})}))
|
|
.value();
|
|
}
|
|
|
|
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};
|
|
|
|
DynamicType r4{R4{}.GetType()};
|
|
// Test subnormal argument flushing
|
|
if (auto callable{GetHostRuntimeWrapper("log", r4, {r4})}) {
|
|
// Biggest IEEE 32bits subnormal power of two
|
|
const Scalar<R4> x1{Scalar<R4>::Word{0x00400000}};
|
|
Scalar<R4> y1Flushing{CallHostRt<R4>(*callable, flushingContext, x1)};
|
|
Scalar<R4> y1NoFlushing{CallHostRt<R4>(*callable, noFlushingContext, x1)};
|
|
// We would expect y1Flushing to be NaN, but some libc logf implementation
|
|
// "workaround" subnormal flushing by returning a constant negative
|
|
// results for all subnormal values (-1.03972076416015625e2_4). In case of
|
|
// flushing, the result should still be different than -88 +/- 2%.
|
|
TEST(y1Flushing.IsInfinite() ||
|
|
std::abs(host::CastFortranToHost<R4>(y1Flushing) + 88.) > 2);
|
|
TEST(!y1NoFlushing.IsInfinite() &&
|
|
std::abs(host::CastFortranToHost<R4>(y1NoFlushing) + 88.) < 2);
|
|
} else {
|
|
TEST(false);
|
|
}
|
|
} else {
|
|
TEST(false); // Cannot run this test on the host
|
|
}
|
|
}
|
|
|
|
int main() {
|
|
RunOnTypes<TestGetScalarConstantValue, AllIntrinsicTypes>::Run();
|
|
TestHostRuntimeSubnormalFlushing();
|
|
return testing::Complete();
|
|
}
|