aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--flang/lib/Evaluate/fold-integer.cpp30
-rw-r--r--flang/lib/Evaluate/fold-real.cpp79
-rw-r--r--flang/test/Evaluate/fold-nearest.f906
-rw-r--r--flang/test/Evaluate/folding04.f9013
4 files changed, 99 insertions, 29 deletions
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index b76b9d4..981cdff 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -1116,14 +1116,25 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return FoldMaxvalMinval<T>(
context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
} else if (name == "mod") {
+ bool badPConst{false};
+ if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
+ *pExpr = Fold(context, std::move(*pExpr));
+ if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
+ pConst->IsZero() &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ context.messages().Say("MOD: P argument is zero"_warn_en_US);
+ badPConst = true;
+ }
+ }
return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
ScalarFuncWithContext<T, T, T>(
- [](FoldingContext &context, const Scalar<T> &x,
+ [badPConst](FoldingContext &context, const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
auto quotRem{x.DivideSigned(y)};
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
- if (quotRem.divisionByZero) {
+ if (!badPConst && quotRem.divisionByZero) {
context.messages().Say("mod() by zero"_warn_en_US);
} else if (quotRem.overflow) {
context.messages().Say("mod() folding overflowed"_warn_en_US);
@@ -1132,12 +1143,23 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return quotRem.remainder;
}));
} else if (name == "modulo") {
+ bool badPConst{false};
+ if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
+ *pExpr = Fold(context, std::move(*pExpr));
+ if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
+ pConst->IsZero() &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ context.messages().Say("MODULO: P argument is zero"_warn_en_US);
+ badPConst = true;
+ }
+ }
return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
- ScalarFuncWithContext<T, T, T>([](FoldingContext &context,
+ ScalarFuncWithContext<T, T, T>([badPConst](FoldingContext &context,
const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
auto result{x.MODULO(y)};
- if (result.overflow &&
+ if (!badPConst && result.overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
context.messages().Say("modulo() folding overflowed"_warn_en_US);
diff --git a/flang/lib/Evaluate/fold-real.cpp b/flang/lib/Evaluate/fold-real.cpp
index f71addc..69c7a92 100644
--- a/flang/lib/Evaluate/fold-real.cpp
+++ b/flang/lib/Evaluate/fold-real.cpp
@@ -303,41 +303,72 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
} else if (name == "mod") {
CHECK(args.size() == 2);
+ bool badPConst{false};
+ if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
+ *pExpr = Fold(context, std::move(*pExpr));
+ if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
+ pConst->IsZero() &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ context.messages().Say("MOD: P argument is zero"_warn_en_US);
+ badPConst = true;
+ }
+ }
return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
- ScalarFunc<T, T, T>(
- [&context](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
- auto result{x.MOD(y)};
- if (result.flags.test(RealFlag::DivideByZero) &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
- context.messages().Say(
- "second argument to MOD must not be zero"_warn_en_US);
- }
- return result.value;
- }));
+ ScalarFunc<T, T, T>([&context, badPConst](const Scalar<T> &x,
+ const Scalar<T> &y) -> Scalar<T> {
+ auto result{x.MOD(y)};
+ if (!badPConst && result.flags.test(RealFlag::DivideByZero) &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ context.messages().Say(
+ "second argument to MOD must not be zero"_warn_en_US);
+ }
+ return result.value;
+ }));
} else if (name == "modulo") {
CHECK(args.size() == 2);
+ bool badPConst{false};
+ if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
+ *pExpr = Fold(context, std::move(*pExpr));
+ if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
+ pConst->IsZero() &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ context.messages().Say("MODULO: P argument is zero"_warn_en_US);
+ badPConst = true;
+ }
+ }
return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
- ScalarFunc<T, T, T>(
- [&context](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
- auto result{x.MODULO(y)};
- if (result.flags.test(RealFlag::DivideByZero) &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
- context.messages().Say(
- "second argument to MODULO must not be zero"_warn_en_US);
- }
- return result.value;
- }));
+ ScalarFunc<T, T, T>([&context, badPConst](const Scalar<T> &x,
+ const Scalar<T> &y) -> Scalar<T> {
+ auto result{x.MODULO(y)};
+ if (!badPConst && result.flags.test(RealFlag::DivideByZero) &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ context.messages().Say(
+ "second argument to MODULO must not be zero"_warn_en_US);
+ }
+ return result.value;
+ }));
} else if (name == "nearest") {
- if (const auto *sExpr{UnwrapExpr<Expr<SomeReal>>(args[1])}) {
+ if (auto *sExpr{UnwrapExpr<Expr<SomeReal>>(args[1])}) {
+ *sExpr = Fold(context, std::move(*sExpr));
return common::visit(
[&](const auto &sVal) {
using TS = ResultType<decltype(sVal)>;
+ bool badSConst{false};
+ if (auto sConst{GetScalarConstantValue<TS>(sVal)}; sConst &&
+ sConst->IsZero() &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingValueChecks)) {
+ context.messages().Say("NEAREST: S argument is zero"_warn_en_US);
+ badSConst = true;
+ }
return FoldElementalIntrinsic<T, T, TS>(context, std::move(funcRef),
ScalarFunc<T, T, TS>([&](const Scalar<T> &x,
const Scalar<TS> &s) -> Scalar<T> {
- if (s.IsZero() &&
+ if (!badSConst && s.IsZero() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingValueChecks)) {
context.messages().Say(
diff --git a/flang/test/Evaluate/fold-nearest.f90 b/flang/test/Evaluate/fold-nearest.f90
index bd8b020..a7366e6 100644
--- a/flang/test/Evaluate/fold-nearest.f90
+++ b/flang/test/Evaluate/fold-nearest.f90
@@ -28,6 +28,12 @@ module m1
logical, parameter :: test_15 = nearest(negZero, 0.) == minSubnormal
logical, parameter :: test_16 = nearest(tiny(1.),-1.) == 1.1754942E-38
logical, parameter :: test_17 = nearest(tiny(1.),1.) == 1.1754945E-38
+ contains
+ subroutine subr(a)
+ real, intent(in) :: a
+ !WARN: warning: NEAREST: S argument is zero
+ print *, nearest(a, 0.)
+ end
end module
module m2
diff --git a/flang/test/Evaluate/folding04.f90 b/flang/test/Evaluate/folding04.f90
index 86ae8deb..c7815b0 100644
--- a/flang/test/Evaluate/folding04.f90
+++ b/flang/test/Evaluate/folding04.f90
@@ -32,11 +32,22 @@ module real_tests
!WARN: warning: invalid argument on evaluation of intrinsic function or operation
real(4), parameter :: nan_r4_acos5 = acos(r4_pinf)
TEST_ISNAN(nan_r4_acos5)
- !WARN: warning: second argument to MOD must not be zero
+ !WARN: warning: MOD: P argument is zero
real(4), parameter :: nan_r4_mod = mod(3.5, 0.)
TEST_ISNAN(nan_r4_mod)
!WARN: warning: overflow on evaluation of intrinsic function or operation
logical, parameter :: test_exp_overflow = exp(256._4).EQ.r4_pinf
+ contains
+ subroutine s1(a,j)
+ !WARN: warning: MOD: P argument is zero
+ print *, mod(a, 0.)
+ !WARN: warning: MODULO: P argument is zero
+ print *, modulo(a, 0.)
+ !WARN: warning: MOD: P argument is zero
+ print *, mod(j, 0.)
+ !WARN: warning: MODULO: P argument is zero
+ print *, modulo(j, 0.)
+ end
end module
module parentheses
generated by cgit v1.1 at 2025-08-04 12:46:07 +0000