Catch infnan repeat counts.

Not entirely convinced this is worth the extra code but getting
"Negative repeat count" warning for NaN repeat count is too much.

Even before this patch, "a" x $Inf didn't go all Genghis over your
virtual memory.  This is all about the right warning.

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index c7c32e3..e1d8e28 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3704,6 +3704,12 @@ in the remaining packages of the MRO of this class.  If you don't want
 it throwing an exception, use C<maybe::next::method>
 or C<next::can>.  See L<mro>.
 
+=item Non-finite repeat count does nothing
+
+(W numeric) You tried to execute the
+L<C<x>|perlop/Multiplicative Operators> repetition operator C<Inf>
+(or C<-Inf>) or C<NaN>, which doesn't make sense.
+
 =item Non-hex character in regex; marked by S<<-- HERE> in m/%s/
 
 (F) In a regular expression, there was a non-hexadecimal character where

diff --git a/pp.c b/pp.c
index 753385b..8c66286 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1649,6 +1649,7 @@ PP(pp_repeat)
     dSP; dATARGET;
     IV count;
     SV *sv;
+    bool infnan = FALSE;
 
     if (GIMME_V == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
        /* TODO: think of some way of doing list-repeat overloading ??? */
@@ -1691,19 +1692,27 @@ PP(pp_repeat)
         }
     }
     else if (SvNOKp(sv)) {
-        const NV nv = SvNV_nomg(sv);
-        if (nv < 0.0)
-              count = -1;   /* An arbitrary negative integer */
-        else
-             count = (IV)nv;
+        const NV nv = SvNV_nomg(sv);
+        infnan = Perl_isinfnan(nv);
+        if (UNLIKELY(infnan)) {
+            count = 0;
+        } else {
+            if (nv < 0.0)
+                count = -1;   /* An arbitrary negative integer */
+            else
+                count = (IV)nv;
+        }
     }
     else
-        count = SvIV_nomg(sv);
+       count = SvIV_nomg(sv);
 
-    if (count < 0) {
+    if (infnan) {
+        Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
+                       "Non-finite repeat count does nothing");
+    } else if (count < 0) {
         count = 0;
         Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
-                                         "Negative repeat count does nothing");
+                       "Negative repeat count does nothing");
     }
 
     if (GIMME_V == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {

diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index a468ebe..009a102 100644 (file)
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -1942,3 +1942,20 @@ no warnings 'numeric';
 EXPECT
 Negative repeat count does nothing at - line 3.
 Negative repeat count does nothing at - line 4.
+########
+my $a = "inf" + 0;
+my $b = -$a;
+my $c = "nan" + 0;
+use warnings 'numeric';
+my $x = "x" x $a;
+my $y = "y" x $b;
+my $z = "z" x $c;
+no warnings 'numeric';
+my $x = "x" x $a;
+my $y = "y" x $b;
+my $z = "z" x $c;
+no warnings 'numeric';
+EXPECT
+Non-finite repeat count does nothing at - line 5.
+Non-finite repeat count does nothing at - line 6.
+Non-finite repeat count does nothing at - line 7.