warn when srand overflows [perl #40605]

diff --git a/pp.c b/pp.c
index d44b4ee..6936b4f 100644 (file)
--- 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 3d49126..5321cde 100644 (file)
--- 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");
+}