flang/unittests/Evaluate/folding.cpp

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