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/target.h"
   9 #include "flang/Evaluate/tools.h"
  10 #include <tuple>
  11
  12 using namespace Fortran::evaluate;
  13
  14 // helper to call functions on all types from tuple
  15 template <typename... T> struct RunOnTypes {};
  16 template <typename Test, typename... T>
  17 struct RunOnTypes<Test, std::tuple<T...>> {
  18   static void Run() { (..., Test::template Run<T>()); }
  19 };
  20
  21 // test for fold.h GetScalarConstantValue function
  22 struct 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
  33 template <typename T>
  34 Scalar<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
  41 void 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 flushing
  61     if (auto callable{GetHostRuntimeWrapper("log", r4, {r4})}) {
  62       // Biggest IEEE 32bits subnormal power of two
  63       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 implementation
  67       // "workaround" subnormal flushing by returning a constant negative
  68       // results for all subnormal values (-1.03972076416015625e2_4). In case of
  69       // 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 host
  79   }
  80 }
  81
  82 int main() {
  83   RunOnTypes<TestGetScalarConstantValue, AllIntrinsicTypes>::Run();
  84   TestHostRuntimeSubnormalFlushing();
  85   return testing::Complete();
  86 }