[flang] Add better invalid argument warnings when folding with host runtime

[jeanPerier]

Summary

Currently, folding was emitting "invalid argument on intrinsic function"
when folding numerical intrinsics with the host runtime like acos(200.).

Add a way to register custom argument checks before folding with the
host runtime. If this checks emit warnings, the default message (that
came from the capture of floating point signals from the math library
call) is skipped.

Arguments range/value checks are added for acos, asin, atan2, mod,
gamma, log_gamma, bessel_y0, bessel_y1, and the elemental bessel_yn.

[klausler]

Please check that failed Windows build to see whether it's related to this change.

[jeanPerier]

Blank line change to test if bot failure is reproducible.

[jeanPerier]

Windows fix attempt: try changing the way the lambda is capturing
the folder since the windows crash seems to be about an invalid
memory reference when the code runs the folder with an check wrapper.

[jeanPerier]

Human reviewers, please ignore and sorry for the noise.
Still testing what can cause crash on windows.
Trying to simplify context message logic since the crash seems to only fire
when folding invalid user code (otherwise folding02.f90should also fail).

flang/lib/Evaluate/host.cpp

if (flags_.empty()) {
     }
     if (errnoCapture == ERANGE) {
       // can't distinguish over/underflow from errno
       flags_.set(RealFlag::Overflow);
     }
   }
 
   if (!flags_.empty()) {
-    RealFlagWarnings(context, flags_, "intrinsic function");
+    RealFlagWarnings(context, flags_, "intrinsic function call");
   }
   errno = 0;
   if (fesetenv(&originalFenv_) != 0) {
     std::fprintf(
         stderr, "fesetenv() failed: %s\n", llvm::sys::StrError(errno).c_str());
     common::die(
         "Folding with host runtime: fesetenv() failed while restoring fenv: %s",
         llvm::sys::StrError(errno).c_str());
   }
 #if __x86_64__
   _mm_setcsr(originalMxcsr);
 #endif
 
   errno = 0;
 }
 } // namespace Fortran::evaluate::host

flang/lib/Evaluate/intrinsics-library.cpp

if (type.category() == TypeCategory::Real ||
     // x87 float to IEEE 128 bits float
     if (type.kind() == common::RealKindForPrecision(64)) {
       return {type.category(), common::RealKindForPrecision(113)};
     }
   }
   return type;
 }
 
+/// Structure to register intrinsic argument checks that must be performed.
+using ArgumentVerifierFunc = bool (*)(
+    const std::vector<Expr<SomeType>> &, FoldingContext &);
+struct ArgumentVerifier {
+  using Key = std::string_view;
+  // Needed for implicit compare with keys.
+  constexpr operator Key() const { return key; }
+  Key key; // intrinsic name
+  ArgumentVerifierFunc verifier;
+};
+
+static constexpr int lastArg{-1};
+static constexpr int firstArg{0};
+
+static const Expr<SomeType> &getArg(
+    int position, const std::vector<Expr<SomeType>> &args) {
+  if (position == lastArg) {
+    CHECK(!args.empty());
+    return args.back();
+  }
+  CHECK(position >= 0 && static_cast<std::size_t>(position) < args.size());
+  return args[position];
+}
+
+template <typename T>
+static bool IsInRange(const Expr<T> &expr, int lb, int ub) {
+  if (auto scalar{GetScalarConstantValue<T>(expr)}) {
+    auto lbValue{Scalar<T>::FromInteger(value::Integer<8>{lb}).value};
+    auto ubValue{Scalar<T>::FromInteger(value::Integer<8>{ub}).value};
+    return Satisfies(RelationalOperator::LE, lbValue.Compare(*scalar)) &&
+        Satisfies(RelationalOperator::LE, scalar->Compare(ubValue));
+  }
+  return true;
+}
+
+/// Verify that the argument in an intrinsic call belongs to [lb, ub] if is
+/// real.
+template <int lb, int ub>
+static bool VerifyInRangeIfReal(
+    const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
+  if (const auto *someReal =
+          std::get_if<Expr<SomeReal>>(&getArg(firstArg, args).u)) {
+    const bool isInRange{
+        std::visit([&](const auto &x) -> bool { return IsInRange(x, lb, ub); },
+            someReal->u)};
+    if (!isInRange) {
+      context.messages().Say(
+          "argument is out of range [%d., %d.]"_en_US, lb, ub);
+    }
+    return isInRange;
+  }
+  return true;
+}
+
+template <int argPosition, const char *argName>
+static bool VerifyStrictlyPositiveIfReal(
+    const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
+  if (const auto *someReal =
+          std::get_if<Expr<SomeReal>>(&getArg(argPosition, args).u)) {
+    const bool isStrictlyPositive{std::visit(
+        [&](const auto &x) -> bool {
+          using T = typename std::decay_t<decltype(x)>::Result;
+          auto scalar{GetScalarConstantValue<T>(x)};
+          return Satisfies(
+              RelationalOperator::LT, Scalar<T>{}.Compare(*scalar));
+        },
+        someReal->u)};
+    if (!isStrictlyPositive) {
+      context.messages().Say(
+          "argument '%s' must be strictly positive"_en_US, argName);
+    }
+    return isStrictlyPositive;
+  }
+  return true;
+}
+
+/// Verify that an intrinsic call argument is not zero if it is real.
+template <int argPosition, const char *argName>
+static bool VerifyNotZeroIfReal(
+    const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
+  if (const auto *someReal =
+          std::get_if<Expr<SomeReal>>(&getArg(argPosition, args).u)) {
+    const bool isNotZero{std::visit(
+        [&](const auto &x) -> bool {
+          using T = typename std::decay_t<decltype(x)>::Result;
+          auto scalar{GetScalarConstantValue<T>(x)};
+          return !scalar || !scalar->IsZero();
+        },
+        someReal->u)};
+    if (!isNotZero) {
+      context.messages().Say(
+          "argument '%s' must be different from zero"_en_US, argName);
+    }
+    return isNotZero;
+  }
+  return true;
+}
+
+/// Verify that the argument in an intrinsic call is not zero if is complex.
+static bool VerifyNotZeroIfComplex(
+    const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
+  if (const auto *someComplex =
+          std::get_if<Expr<SomeComplex>>(&getArg(firstArg, args).u)) {
+    const bool isNotZero{std::visit(
+        [&](const auto &z) -> bool {
+          using T = typename std::decay_t<decltype(z)>::Result;
+          auto scalar{GetScalarConstantValue<T>(z)};
+          return !scalar || !scalar->IsZero();
+        },
+        someComplex->u)};
+    if (!isNotZero) {
+      context.messages().Say(
+          "complex argument must be different from zero"_en_US);
+    }
+    return isNotZero;
+  }
+  return true;
+}
+
+// Verify that the argument in an intrinsic call is not zero and not a negative
+// integer.
+static bool VerifyGammaLikeArgument(
+    const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
+  if (const auto *someReal =
+          std::get_if<Expr<SomeReal>>(&getArg(firstArg, args).u)) {
+    const bool isValid{std::visit(
+        [&](const auto &x) -> bool {
+          using T = typename std::decay_t<decltype(x)>::Result;
+          auto scalar{GetScalarConstantValue<T>(x)};
+          if (scalar) {
+            return !scalar->IsZero() &&
+                !(scalar->IsNegative() &&
+                    scalar->ToWholeNumber().value == scalar);
+          }
+          return true;
+        },
+        someReal->u)};
+    if (!isValid) {
+      context.messages().Say(
+          "argument must not be a negative integer or zero"_en_US);
+    }
+    return isValid;
+  }
+  return true;
+}
+
+// Verify that two real arguments are not both zero.
+static bool VerifyAtan2LikeArguments(
+    const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
+  if (const auto *someReal =
+          std::get_if<Expr<SomeReal>>(&getArg(firstArg, args).u)) {
+    const bool isValid{std::visit(
+        [&](const auto &typedExpr) -> bool {
+          using T = typename std::decay_t<decltype(typedExpr)>::Result;
+          auto x{GetScalarConstantValue<T>(typedExpr)};
+          auto y{GetScalarConstantValue<T>(getArg(lastArg, args))};
+          if (x && y) {
+            return !(x->IsZero() && y->IsZero());
+          }
+          return true;
+        },
+        someReal->u)};
+    if (!isValid) {
+      context.messages().Say(
+          "'x' and 'y' arguments must not be both zero"_en_US);
+    }
+    return isValid;
+  }
+  return true;
+}
+
+template <ArgumentVerifierFunc... F>
+static bool CombineVerifiers(
+    const std::vector<Expr<SomeType>> &args, FoldingContext &context) {
+  return (... & F(args, context));
+}
+
+/// Define argument names to be used error messages when the intrinsic have
+/// several arguments.
+static constexpr char xName[]{"x"};
+static constexpr char pName[]{"p"};
+
+/// Register argument verifiers for all intrinsics folded with runtime.
+static constexpr ArgumentVerifier intrinsicArgumentVerifiers[]{
+    {"acos", VerifyInRangeIfReal<-1, 1>},
+    {"asin", VerifyInRangeIfReal<-1, 1>},
+    {"atan2", VerifyAtan2LikeArguments},
+    {"bessel_y0", VerifyStrictlyPositiveIfReal<firstArg, xName>},
+    {"bessel_y1", VerifyStrictlyPositiveIfReal<firstArg, xName>},
+    {"bessel_yn", VerifyStrictlyPositiveIfReal<lastArg, xName>},
+    {"gamma", VerifyGammaLikeArgument},
+    {"log",
+        CombineVerifiers<VerifyStrictlyPositiveIfReal<firstArg, xName>,
+            VerifyNotZeroIfComplex>},
+    {"log10", VerifyStrictlyPositiveIfReal<firstArg, xName>},
+    {"log_gamma", VerifyGammaLikeArgument},
+    {"mod", VerifyNotZeroIfReal<lastArg, pName>},
+};
+
+const ArgumentVerifierFunc *findVerifier(const std::string &intrinsicName) {
+  static constexpr Fortran::common::StaticMultimapView<ArgumentVerifier>
+      verifiers(intrinsicArgumentVerifiers);
+  static_assert(verifiers.Verify(), "map must be sorted");
+  auto range{verifiers.equal_range(intrinsicName)};
+  if (range.first != range.second) {
+    return &range.first->verifier;
+  }
+  return nullptr;
+}
+
+/// Ensure argument verifiers, if any, are run before calling the runtime
+/// wrapper to fold an intrinsic.
+static HostRuntimeWrapper AddArgumentVerifierIfAny(
+    const std::string &intrinsicName, const HostRuntimeFunction &hostFunction) {
+  if (const auto *verifier{findVerifier(intrinsicName)}) {
+    const HostRuntimeFunction *hostFunctionPtr = &hostFunction;
+    return [hostFunctionPtr, verifier](
+               FoldingContext &context, std::vector<Expr<SomeType>> &&args) {
+      const bool validArguments{(*verifier)(args, context)};
+      if (!validArguments) {
+        // Silence fp signal warnings since a more detailed warning about
+        // invalid arguments was already emitted.
+        parser::Messages localBuffer;
+        parser::ContextualMessages localMessages{&localBuffer};
+        FoldingContext localContext{context, localMessages};
+        return hostFunctionPtr->folder(localContext, std::move(args));
+      }
+      return hostFunctionPtr->folder(context, std::move(args));
+    };
+  }
+  return hostFunction.folder;
+}
+
 std::optional<HostRuntimeWrapper> GetHostRuntimeWrapper(const std::string &name,
     DynamicType resultType, const std::vector<DynamicType> &argTypes) {
   if (const auto *hostFunction{SearchHostRuntime(name, resultType, argTypes)}) {
-    return hostFunction->folder;
+    return AddArgumentVerifierIfAny(name, *hostFunction);
   }
   // If no exact match, search with "bigger" types and insert type
   // conversions around the folder.
   std::vector<evaluate::DynamicType> biggerArgTypes;
   evaluate::DynamicType biggerResultType{BiggerType(resultType)};
   for (auto type : argTypes) {
     biggerArgTypes.emplace_back(BiggerType(type));
   }
   if (const auto *hostFunction{
           SearchHostRuntime(name, biggerResultType, biggerArgTypes)}) {
-    return [hostFunction, resultType](
+    auto hostFolderWithChecks{AddArgumentVerifierIfAny(name, *hostFunction)};
+    return [hostFunction, resultType, hostFolderWithChecks](
                FoldingContext &context, std::vector<Expr<SomeType>> &&args) {
       auto nArgs{args.size()};
       for (size_t i{0}; i < nArgs; ++i) {
         args[i] = Fold(context,
             ConvertToType(hostFunction->argumentTypes[i], std::move(args[i]))
                 .value());
       }
       return Fold(context,
           ConvertToType(
-              resultType, hostFunction->folder(context, std::move(args)))
+              resultType, hostFolderWithChecks(context, std::move(args)))
               .value());
     };
   }
   return std::nullopt;
 }
 } // namespace Fortran::evaluate

flang/test/Evaluate/folding04.f90

module real_tests
   real(4), parameter :: r4_nmax = -3.4028235E38
   !WARN: invalid argument on division
   real(4), parameter :: r4_nan = 0._4/0._4
   !WARN: division by zero
   real(4), parameter :: r4_pinf = 1._4/0._4
   !WARN: division by zero
   real(4), parameter :: r4_ninf = -1._4/0._4
 
-  !WARN: invalid argument on intrinsic function
+  !WARN: argument is out of range [-1., 1.]
   real(4), parameter :: nan_r4_acos1 = acos(1.1)
   TEST_ISNAN(nan_r4_acos1)
-  !WARN: invalid argument on intrinsic function
+  !WARN: argument is out of range [-1., 1.]
   real(4), parameter :: nan_r4_acos2 = acos(r4_pmax)
   TEST_ISNAN(nan_r4_acos2)
-  !WARN: invalid argument on intrinsic function
+  !WARN: argument is out of range [-1., 1.]
   real(4), parameter :: nan_r4_acos3 = acos(r4_nmax)
   TEST_ISNAN(nan_r4_acos3)
-  !WARN: invalid argument on intrinsic function
+  !WARN: argument is out of range [-1., 1.]
   real(4), parameter :: nan_r4_acos4 = acos(r4_ninf)
   TEST_ISNAN(nan_r4_acos4)
-  !WARN: invalid argument on intrinsic function
+  !WARN: argument is out of range [-1., 1.]
   real(4), parameter :: nan_r4_acos5 = acos(r4_pinf)
   TEST_ISNAN(nan_r4_acos5)
+  !WARN: argument is out of range [-1., 1.]
+  real(8), parameter :: nan_r8_dasin1 = dasin(-1.1_8)
+  TEST_ISNAN(nan_r8_dasin1)
+  !WARN: argument 'x' must be strictly positive
+  real(8), parameter :: nan_r8_dlog1 = dlog(-0.1_8)
+  TEST_ISNAN(nan_r8_dlog1)
+  !WARN: complex argument must be different from zero
+  complex(4), parameter :: c4_clog1 = clog((0., 0.))
+  !WARN: argument 'p' must be different from zero
+  real(4), parameter :: nan_r4_mod = mod(3.5, 0.)
+  TEST_ISNAN(nan_r4_mod)
+  real(4), parameter :: ok_r4_gamma = gamma(-1.1)
+  !WARN: argument must not be a negative integer or zero
+  real(4), parameter :: r4_gamma1 = gamma(0.)
+  !WARN: argument must not be a negative integer or zero
+  real(4), parameter :: r4_gamma2 = gamma(-1.)
+  real(4), parameter :: ok_r4_log_gamma = log_gamma(-2.001)
+  !WARN: argument must not be a negative integer or zero
+  real(4), parameter :: r4_log_gamma1 = log_gamma(0.)
+  !WARN: argument must not be a negative integer or zero
+  real(4), parameter :: r4_log_gamma2 = log_gamma(-100001.)
+  !WARN: 'x' and 'y' arguments must not be both zero
+  real(4), parameter :: r4_atan2 = atan2(0., 0.)
 
-  !WARN: overflow on intrinsic function
+  !WARN: overflow on intrinsic function call
   logical, parameter :: test_exp_overflow = exp(256._4).EQ.r4_pinf
 end module
 
 module parentheses
   ! Test parentheses in folding (they are kept around constants to keep the
   ! distinction between variable and expressions and require special care).
   real(4), parameter :: x_nop = 0.1_4
   real(4), parameter :: x_p = (x_nop)