diff --git a/flang/lib/Evaluate/host.cpp b/flang/lib/Evaluate/host.cpp --- a/flang/lib/Evaluate/host.cpp +++ b/flang/lib/Evaluate/host.cpp @@ -141,7 +141,7 @@ } if (!flags_.empty()) { - RealFlagWarnings(context, flags_, "intrinsic function"); + RealFlagWarnings(context, flags_, "intrinsic function call"); } errno = 0; if (fesetenv(&originalFenv_) != 0) { diff --git a/flang/lib/Evaluate/intrinsics-library.cpp b/flang/lib/Evaluate/intrinsics-library.cpp --- a/flang/lib/Evaluate/intrinsics-library.cpp +++ b/flang/lib/Evaluate/intrinsics-library.cpp @@ -477,10 +477,243 @@ return type; } +/// Structure to register intrinsic argument checks that must be performed. +using ArgumentVerifierFunc = bool (*)( + const std::vector> &, 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 &getArg( + int position, const std::vector> &args) { + if (position == lastArg) { + CHECK(!args.empty()); + return args.back(); + } + CHECK(position >= 0 && static_cast(position) < args.size()); + return args[position]; +} + +template +static bool IsInRange(const Expr &expr, int lb, int ub) { + if (auto scalar{GetScalarConstantValue(expr)}) { + auto lbValue{Scalar::FromInteger(value::Integer<8>{lb}).value}; + auto ubValue{Scalar::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 +static bool VerifyInRangeIfReal( + const std::vector> &args, FoldingContext &context) { + if (const auto *someReal = + std::get_if>(&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 +static bool VerifyStrictlyPositiveIfReal( + const std::vector> &args, FoldingContext &context) { + if (const auto *someReal = + std::get_if>(&getArg(argPosition, args).u)) { + const bool isStrictlyPositive{std::visit( + [&](const auto &x) -> bool { + using T = typename std::decay_t::Result; + auto scalar{GetScalarConstantValue(x)}; + return Satisfies( + RelationalOperator::LT, Scalar{}.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 +static bool VerifyNotZeroIfReal( + const std::vector> &args, FoldingContext &context) { + if (const auto *someReal = + std::get_if>(&getArg(argPosition, args).u)) { + const bool isNotZero{std::visit( + [&](const auto &x) -> bool { + using T = typename std::decay_t::Result; + auto scalar{GetScalarConstantValue(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> &args, FoldingContext &context) { + if (const auto *someComplex = + std::get_if>(&getArg(firstArg, args).u)) { + const bool isNotZero{std::visit( + [&](const auto &z) -> bool { + using T = typename std::decay_t::Result; + auto scalar{GetScalarConstantValue(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> &args, FoldingContext &context) { + if (const auto *someReal = + std::get_if>(&getArg(firstArg, args).u)) { + const bool isValid{std::visit( + [&](const auto &x) -> bool { + using T = typename std::decay_t::Result; + auto scalar{GetScalarConstantValue(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> &args, FoldingContext &context) { + if (const auto *someReal = + std::get_if>(&getArg(firstArg, args).u)) { + const bool isValid{std::visit( + [&](const auto &typedExpr) -> bool { + using T = typename std::decay_t::Result; + auto x{GetScalarConstantValue(typedExpr)}; + auto y{GetScalarConstantValue(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 +static bool CombineVerifiers( + const std::vector> &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}, + {"bessel_y1", VerifyStrictlyPositiveIfReal}, + {"bessel_yn", VerifyStrictlyPositiveIfReal}, + {"gamma", VerifyGammaLikeArgument}, + {"log", + CombineVerifiers, + VerifyNotZeroIfComplex>}, + {"log10", VerifyStrictlyPositiveIfReal}, + {"log_gamma", VerifyGammaLikeArgument}, + {"mod", VerifyNotZeroIfReal}, +}; + +const ArgumentVerifierFunc *findVerifier(const std::string &intrinsicName) { + static constexpr Fortran::common::StaticMultimapView + 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> &&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 GetHostRuntimeWrapper(const std::string &name, DynamicType resultType, const std::vector &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. @@ -491,7 +724,8 @@ } if (const auto *hostFunction{ SearchHostRuntime(name, biggerResultType, biggerArgTypes)}) { - return [hostFunction, resultType]( + auto hostFolderWithChecks{AddArgumentVerifierIfAny(name, *hostFunction)}; + return [hostFunction, resultType, hostFolderWithChecks]( FoldingContext &context, std::vector> &&args) { auto nArgs{args.size()}; for (size_t i{0}; i < nArgs; ++i) { @@ -501,7 +735,7 @@ } return Fold(context, ConvertToType( - resultType, hostFunction->folder(context, std::move(args))) + resultType, hostFolderWithChecks(context, std::move(args))) .value()); }; } diff --git a/flang/test/Evaluate/folding04.f90 b/flang/test/Evaluate/folding04.f90 --- a/flang/test/Evaluate/folding04.f90 +++ b/flang/test/Evaluate/folding04.f90 @@ -17,23 +17,46 @@ !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