This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sv.c: Suppress imprecision warnings on Inf.
authorTAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
Tue, 22 Dec 2020 18:56:12 +0000 (03:56 +0900)
committerKarl Williamson <khw@cpan.org>
Tue, 29 Dec 2020 13:22:35 +0000 (06:22 -0700)
This commit will partially revert the effect of the commit
c33ee94ba2086d48e3750cfdeb51402b61bb1ac7. [GH #18388]

sv.c
t/op/inc.t

diff --git a/sv.c b/sv.c
index 3942b54..dc85b83 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8952,9 +8952,11 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
         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)
+                     was < -NV_OVERFLOWS_INTEGERS_AT) &&
 #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
-            && LIKELY(!Perl_isnan(was))
+            LIKELY(!Perl_isinfnan(was))
+#else
+            LIKELY(!Perl_isinf(was))
 #endif
             ) {
            /* diag_listed_as: Lost precision when %s %f by 1 */
@@ -9136,9 +9138,11 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv)
             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)
+                         was > NV_OVERFLOWS_INTEGERS_AT) &&
 #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
-                && LIKELY(!Perl_isnan(was)))
+                LIKELY(!Perl_isinfnan(was)))
+#else
+                LIKELY(!Perl_isinf(was))
 #endif
                 ) {
                /* diag_listed_as: Lost precision when %s %f by 1 */
index 6d0f7b7..4ea3c6c 100644 (file)
@@ -258,11 +258,7 @@ EOC
     # 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']) {
+             [$start_p + 4, '$i--', 'positive large value', 'dec']) {
        my ($start, $action, $description, $act) = @$_;
        my $code = eval << "EOC" or die $@;
 sub {
@@ -423,4 +419,28 @@ SKIP: {
     }
 } # SKIP
 
+# Incrementing/decrementing Inf/NaN should not trigger 'imprecision' warnings
+# [GH #18333, #18388]
+# Note these tests only check for warnings; t/op/infnan.t has tests that
+# checks the result of incrementing/decrementing Inf/NaN.
+foreach my $infnan ('+Inf', '-Inf', 'NaN') {
+    my $start = $infnan + 0;
+  SKIP: {
+      skip "NV does not have $infnan", 2
+          unless ($infnan eq 'NaN' ? $Config{d_double_has_nan} : $Config{d_double_has_inf});
+      foreach (['$i++', 'inc'],
+               ['$i--', 'dec']) {
+          my ($action, $act) = @$_;
+          my $code = eval <<"EOC" or die $@;
+sub {
+    use warnings 'imprecision';
+    my \$i = \$start;
+    $action;
+}
+EOC
+          warning_is($code, undef, "${act}rementing $infnan under use warnings 'imprecision'");
+      }
+    } # SKIP
+}
+
 done_testing();