Add a new env var PERL_RAND_SEED

This env var can be used to trigger a repeatable run of a script which
calls C<srand()> with no arguments, either explicitly or implicitly
via use of C<rand()> prior to calling srand(). This is implemented in
such a way that calling C<srand()> with no arguments in forks or
subthreads (again explicitly or implicitly) will receive their own seed
but the seeds they receive will be repeatable.

This is intended for debugging and perl development performance testing,
and for running the test suite consistently. It is documented that the
exact seeds used to initialize the random state are unspecified, and
that they may change between releases or even builds. The only guarantee
provided is that the same perl executable will produce the same results
twice all other things being equal. In practice and in core testing we
do expect consistency, but adding the tightest set of restrictions on
our commitments seemed sensible.

The env var is ignored when perl is run setuid or setgid similarly to
the C<PERL_INTERNAL_RAND_SEED> env var.

3 files changed, 15 insertions, 3 deletions

diff --git a/dist/threads/t/thread.t b/dist/threads/t/thread.t
index 4dc1a292d8..8a56bb6fbd 100644
--- a/dist/threads/t/thread.t
+++ b/dist/threads/t/thread.t
@@ -11,6 +11,7 @@ BEGIN {
 }
 
 use ExtUtils::testlib;
+use Data::Dumper;
 
 use threads;
 
@@ -156,7 +157,8 @@ package main;
     rand(10);
     threads->create( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25;
     $_->join foreach threads->list;
-    ok((keys %rand >= 23), "Check that rand() is randomized in new threads");
+    ok((keys %rand >= 23), "Check that rand() is randomized in new threads")
+        or diag Dumper(\%rand);
 }
 
 # bugid #24165
diff --git a/dist/threads/t/version.t b/dist/threads/t/version.t
index dff8d342f5..fb9130903a 100644
--- a/dist/threads/t/version.t
+++ b/dist/threads/t/version.t
@@ -1,8 +1,17 @@
 use strict;
 use warnings;
-use threads;
 use Test::More;
 
+BEGIN {
+    use Config;
+    if (! $Config{'useithreads'}) {
+        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
+        exit(0);
+    }
+}
+
+use threads;
+
 # test that the version documented in threads.pm pod matches
 # that of the code.
 
diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs
index 9c8072d9f5..b4fa1121ed 100644
--- a/dist/threads/threads.xs
+++ b/dist/threads/threads.xs
@@ -807,6 +807,7 @@ S_ithread_create(
     thread->gimme = gimme;
     thread->state = exit_opt;
 
+
     /* "Clone" our interpreter into the thread's interpreter.
      * This gives thread access to "static data" and code.
      */
@@ -1171,6 +1172,7 @@ ithread_create(...)
         if (! thread) {
             XSRETURN_UNDEF;     /* Mutex already unlocked */
         }
+        PERL_SRAND_OVERRIDE_NEXT_PARENT();
         ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, FALSE));
 
         /* Let thread run. */
@@ -1179,7 +1181,6 @@ ithread_create(...)
         /* warning: releasing mutex 'thread->mutex' that was not held [-Wthread-safety-analysis] */
         MUTEX_UNLOCK(&thread->mutex);
         CLANG_DIAG_RESTORE_STMT;
-
         /* XSRETURN(1); - implied */