sv.c: more imprecision warnings on increment/decrement

Previously, imprecision warnings on increment (Lost precision when
incrementing %f by 1) were only issued on positive finite values,
and, on decrement, only issued on negative finite values.
This commit extends this warnings on both sign and infinite values.

This fixes GH #18333.

diff --git a/sv.c b/sv.c
index f906901..3942b54 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8949,9 +8949,14 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
     }
     if (flags & SVp_NOK) {
        const NV was = SvNVX(sv);
-       if (LIKELY(!Perl_isinfnan(was)) &&
-            NV_OVERFLOWS_INTEGERS_AT != 0.0 &&
-           was >= NV_OVERFLOWS_INTEGERS_AT) {
+        if (NV_OVERFLOWS_INTEGERS_AT != 0.0 &&
+            /* If NVX was NaN, the following comparisons return always false */
+            UNLIKELY(was >= NV_OVERFLOWS_INTEGERS_AT ||
+                     was < -NV_OVERFLOWS_INTEGERS_AT)
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+            && LIKELY(!Perl_isnan(was))
+#endif
+            ) {
            /* diag_listed_as: Lost precision when %s %f by 1 */
            Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
                           "Lost precision when incrementing %" NVff " by 1",
@@ -9128,9 +9133,14 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv)
     oops_its_num:
        {
            const NV was = SvNVX(sv);
-           if (LIKELY(!Perl_isinfnan(was)) &&
-                NV_OVERFLOWS_INTEGERS_AT != 0.0 &&
-               was <= -NV_OVERFLOWS_INTEGERS_AT) {
+            if (NV_OVERFLOWS_INTEGERS_AT != 0.0 &&
+                /* If NVX was NaN, these comparisons return always false */
+                UNLIKELY(was <= -NV_OVERFLOWS_INTEGERS_AT ||
+                         was > NV_OVERFLOWS_INTEGERS_AT)
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+                && LIKELY(!Perl_isnan(was)))
+#endif
+                ) {
                /* diag_listed_as: Lost precision when %s %f by 1 */
                Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
                               "Lost precision when decrementing %" NVff " by 1",

diff --git a/t/op/inc.t b/t/op/inc.t
index 3d5cc02..6d0f7b7 100644 (file)
--- a/t/op/inc.t
+++ b/t/op/inc.t
@@ -255,6 +255,26 @@ EOC
                      "$description under use warnings 'imprecision'");
     }
 
+    # Verify warnings on incrementing/decrementing large values
+    # whose integral part will not fit in NVs. [GH #18333]
+    foreach ([$start_n - 4, '$i++', 'negative large value', 'inc'],
+             ['+Inf' + 0,   '$i++', '+Inf', 'inc'],
+             ['-Inf' + 0,   '$i++', '-Inf', 'inc'],
+             [$start_p + 4, '$i--', 'positive large value', 'dec'],
+             ['+Inf' + 0,   '$i--', '+Inf', 'dec'],
+             ['-Inf' + 0,   '$i--', '-Inf', 'dec']) {
+       my ($start, $action, $description, $act) = @$_;
+       my $code = eval << "EOC" or die $@;
+sub {
+    use warnings 'imprecision';
+    my \$i = \$start;
+    $action;
+}
+EOC
+        warning_like($code, qr/Lost precision when ${act}rementing /,
+                     "${act}rementing $description under use warnings 'imprecision'");
+    }
+
     $found = 1;
     last;
 }