Add limits to the size of the string repetition multiplier

Historically, given a statement like `my $x = "A" x SOMECONSTANT;`, no
examination of the size of the multiplier (`SOMECONSTANT` in this example)
was done at compile time. Depending upon the constant folding behaviour,
this might mean:
* The buffer allocation needed at runtime could be clearly bigger than
  the system can support, but Perl would happily compile the statement
  and let the author find this out at runtime.
* Constants resulting from folding could be very large and the memory
  taken up undesirable, especially in cases where the constant resides
  in cold code.

This commit adds some compile time checking such that:
* A string size beyond or close to the likely limit of support triggers
  a fatal error.
* Strings above a certain static size do not get constant folded.

Author: richardleach

op.c

@@ -4871,6 +4871,39 @@ S_fold_constants(pTHX_ OP *const o)
         break;
     case OP_REPEAT:
         if (o->op_private & OPpREPEAT_DOLIST) goto nope;
+        /* Croak if the string is going to be unrealistically
+         * large. (GH#13324) Otherwise, don't constant fold
+         * above a certain threshold. (GH#13793 & GH#20586)
+         *
+         * Implementation note: pp_pow returns powers of 2 as an NV
+         *     e.g. my $x = "A" x (2**3);
+         */
+        if (OP_TYPE_IS(cBINOPo->op_last, OP_CONST)) {
+            SV *constsv = cSVOPx_sv(cBINOPo->op_last);
+            UV arbitrary = 1024 * 1024;
+
+            if (SvIOKp(constsv)) {
+                if (SvIOK_UV(constsv)) {
+                    if (SvUVX(constsv) > SIZE_MAX >> 2)
+                        goto repetition_die;
+                    if (SvUVX(constsv) > arbitrary)
+                        goto nope;
+                } else {
+                    if (SvIVX(constsv) > (IV)(SIZE_MAX >> 2))
+                        goto repetition_die;
+                    if (SvIVX(constsv) > (IV)arbitrary)
+                        goto nope;
+                }
+            } else {
+                NV rhs = SvNV_nomg(constsv);
+                if (rhs > (NV)(SIZE_MAX >> 2)) {
+                  repetition_die:
+                    DIE(aTHX_ "Unrealistically large string repetition value");
+                }
+                if (rhs > (NV)arbitrary)
+                    goto nope;
+            }
+        }
         break;
     case OP_SREFGEN:
         if (cUNOPx(cUNOPo->op_first)->op_first->op_type != OP_CONST

pod/perldiag.pod

@@ -6971,6 +6971,18 @@ reserved word.  It's best to put such a word in quotes, or capitalize it
 somehow, or insert an underbar into it.  You might also declare it as a
 subroutine.
 
+=item Unrealistically large string repetition value
+
+The value of the right operand in the string repetition operator is
+likely close to or will exceed the maximum memory allocation that
+your system can provide.
+
+Even if an allocation of this size does succeed, subsequent string
+copies may still result in an out-of-memory condition.
+
+Note that a smaller memory constraint might be imposed on your
+application under C<ulimit>, if containerized, or other local configuration.
+
 =item Unrecognized character %s; marked by S<<-- HERE> after %s near column
 %d
 

t/op/repeat.t

@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc( '../lib' );
 }
 
-plan(tests => 50);
+plan(tests => 51);
 
 # compile time
 
@@ -193,6 +193,14 @@ fresh_perl_like(
 eval q{() = (() or ((0) x 0)); 1};
 is($@, "", "RT #130247");
 
+# [GH #13324] Perl croaks if a string repetition seems unsupportable
+fresh_perl_like(
+ 'my $x = "A" x (2**99)',
+  qr/Unrealistically large string repetition/,
+  {  },
+ 'Croak on unrealistically large string repetition',
+);
+
 # yes, the newlines matter
 fresh_perl_is(<<'PERL', "", { stderr => 1 }, "(perl #133778) MARK mishandling");
 map{s[][];eval;0}<DATA>__END__

t/perf/opcount.t

@@ -1012,4 +1012,11 @@ test_opcount(0, "Empty anonhash ref and direct lexical assignment",
                     srefgen     => 1,
                 });
 
+# GH #13793, GH #20586
+test_opcount(0, "Don't fold string repetition once deeemed too large",
+                sub { my $x = "A" x (2**22) },
+                {
+                    repeat      => 1,
+                });
+
 done_testing();