diff options
-rw-r--r-- | pp.c | 23 | ||||
-rw-r--r-- | t/op/srand.t | 11 |
2 files changed, 32 insertions, 2 deletions
@@ -2658,7 +2658,28 @@ PP(pp_rand) PP(pp_srand) { dVAR; dSP; dTARGET; - const UV anum = (MAXARG < 1 || (!TOPs && !POPs)) ? seed() : POPu; + UV anum; + + if (MAXARG >= 1 && TOPs) { + SV *top; + char *pv; + STRLEN len; + int flags; + + top = POPs; + pv = SvPV(top, len); + flags = grok_number(pv, len, &anum); + + if (!(flags & IS_NUMBER_IN_UV)) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in srand"); + anum = UV_MAX; + } + } + else { + anum = seed(); + } + (void)seedDrand01((Rand_seed_t)anum); PL_srand_called = TRUE; if (anum) diff --git a/t/op/srand.t b/t/op/srand.t index 3d49126268..5321cde656 100644 --- a/t/op/srand.t +++ b/t/op/srand.t @@ -10,7 +10,7 @@ BEGIN { use strict; require "test.pl"; -plan(tests => 9); +plan(tests => 10); # Generate a load of random numbers. # int() avoids possible floating point error. @@ -79,3 +79,12 @@ cmp_ok( $seed, '==', 0, "numeric 0 return value for srand(0)"); is( $b, 0, "Quacks like a zero"); is( "@warnings", "", "Does not warn"); } + +# [perl #40605] +{ + use warnings; + my $w = ''; + local $SIG{__WARN__} = sub { $w .= $_[0] }; + srand(2**100); + like($w, qr/^Integer overflow in srand at /, "got a warning"); +} |