summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--pp.c23
-rw-r--r--t/op/srand.t11
2 files changed, 32 insertions, 2 deletions
diff --git a/pp.c b/pp.c
index d44b4eea05..6936b4f796 100644
--- a/pp.c
+++ b/pp.c
@@ -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");
+}