87 lines · cpp
1#include "../../lib/Evaluate/host.h"2#include "flang/Evaluate/call.h"3#include "flang/Evaluate/expression.h"4#include "flang/Evaluate/fold.h"5#include "flang/Evaluate/intrinsics-library.h"6#include "flang/Evaluate/intrinsics.h"7#include "flang/Evaluate/target.h"8#include "flang/Evaluate/tools.h"9#include "flang/Testing/testing.h"10#include <tuple>11 12using namespace Fortran::evaluate;13 14// helper to call functions on all types from tuple15template <typename... T> struct RunOnTypes {};16template <typename Test, typename... T>17struct RunOnTypes<Test, std::tuple<T...>> {18 static void Run() { (..., Test::template Run<T>()); }19};20 21// test for fold.h GetScalarConstantValue function22struct TestGetScalarConstantValue {23 template <typename T> static void Run() {24 Expr<T> exprFullyTyped{Constant<T>{Scalar<T>{}}};25 Expr<SomeKind<T::category>> exprSomeKind{exprFullyTyped};26 Expr<SomeType> exprSomeType{exprSomeKind};27 TEST(GetScalarConstantValue<T>(exprFullyTyped).has_value());28 TEST(GetScalarConstantValue<T>(exprSomeKind).has_value());29 TEST(GetScalarConstantValue<T>(exprSomeType).has_value());30 }31};32 33template <typename T>34Scalar<T> CallHostRt(35 HostRuntimeWrapper func, FoldingContext &context, Scalar<T> x) {36 return GetScalarConstantValue<T>(37 func(context, {AsGenericExpr(Constant<T>{x})}))38 .value();39}40 41void TestHostRuntimeSubnormalFlushing() {42 using R4 = Type<TypeCategory::Real, 4>;43 if constexpr (std::is_same_v<host::HostType<R4>, float>) {44 Fortran::parser::CharBlock src;45 Fortran::parser::ContextualMessages messages{src, nullptr};46 Fortran::common::IntrinsicTypeDefaultKinds defaults;47 auto intrinsics{Fortran::evaluate::IntrinsicProcTable::Configure(defaults)};48 TargetCharacteristics flushingTargetCharacteristics;49 flushingTargetCharacteristics.set_areSubnormalsFlushedToZero(true);50 TargetCharacteristics noFlushingTargetCharacteristics;51 noFlushingTargetCharacteristics.set_areSubnormalsFlushedToZero(false);52 Fortran::common::LanguageFeatureControl languageFeatures;53 std::set<std::string> tempNames;54 FoldingContext flushingContext{messages, defaults, intrinsics,55 flushingTargetCharacteristics, languageFeatures, tempNames};56 FoldingContext noFlushingContext{messages, defaults, intrinsics,57 noFlushingTargetCharacteristics, languageFeatures, tempNames};58 59 DynamicType r4{R4{}.GetType()};60 // Test subnormal argument flushing61 if (auto callable{GetHostRuntimeWrapper("log", r4, {r4})}) {62 // Biggest IEEE 32bits subnormal power of two63 const Scalar<R4> x1{Scalar<R4>::Word{0x00400000}};64 Scalar<R4> y1Flushing{CallHostRt<R4>(*callable, flushingContext, x1)};65 Scalar<R4> y1NoFlushing{CallHostRt<R4>(*callable, noFlushingContext, x1)};66 // We would expect y1Flushing to be NaN, but some libc logf implementation67 // "workaround" subnormal flushing by returning a constant negative68 // results for all subnormal values (-1.03972076416015625e2_4). In case of69 // flushing, the result should still be different than -88 +/- 2%.70 TEST(y1Flushing.IsInfinite() ||71 std::abs(host::CastFortranToHost<R4>(y1Flushing) + 88.) > 2);72 TEST(!y1NoFlushing.IsInfinite() &&73 std::abs(host::CastFortranToHost<R4>(y1NoFlushing) + 88.) < 2);74 } else {75 TEST(false);76 }77 } else {78 TEST(false); // Cannot run this test on the host79 }80}81 82int main() {83 RunOnTypes<TestGetScalarConstantValue, AllIntrinsicTypes>::Run();84 TestHostRuntimeSubnormalFlushing();85 return testing::Complete();86}87