summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2022-08-05 13:18:02 +0200
committerYves Orton <demerphq@gmail.com>2022-08-12 22:29:05 +0200
commitbf2a3dae9f4f828fd1f2f8aaf4769f96520c9552 (patch)
treeb58ad50f0d8d828bb5a890686e0ce7e82ae529ae
parent08da5deb5d0c842dab3fe5f4f5a450972a0eb67c (diff)
downloadperl-bf2a3dae9f4f828fd1f2f8aaf4769f96520c9552.tar.gz
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.
-rw-r--r--INSTALL6
-rw-r--r--MANIFEST3
-rw-r--r--dist/threads/t/thread.t4
-rw-r--r--dist/threads/t/version.t11
-rw-r--r--dist/threads/threads.xs3
-rw-r--r--embedvar.h2
-rw-r--r--handy.h72
-rw-r--r--hv.c4
-rw-r--r--intrpvar.h4
-rw-r--r--perl.c37
-rw-r--r--perl.h25
-rw-r--r--pod/perldelta.pod11
-rw-r--r--pod/perlfunc.pod16
-rw-r--r--pod/perlrun.pod26
-rw-r--r--pp.c20
-rw-r--r--pp_sys.c17
-rw-r--r--sv.c2
-rw-r--r--t/op/srand.t9
-rw-r--r--t/run/runenv_randseed.t68
19 files changed, 313 insertions, 27 deletions
diff --git a/INSTALL b/INSTALL
index a06b27ad98..527401f13e 100644
--- a/INSTALL
+++ b/INSTALL
@@ -2755,6 +2755,12 @@ X<PERL_INTERNAL_RAND_SEED>
If you configure perl with C<-Accflags=-DNO_PERL_INTERNAL_RAND_SEED>,
perl will ignore the C<PERL_INTERNAL_RAND_SEED> environment variable.
+=head2 C<-DNO_PERL_RAND_SEED>
+X<PERL_RAND_SEED>
+
+If you configure perl with C<-Accflags=-DNO_PERL_RAND_SEED>,
+perl will ignore the C<PERL_RAND_SEED> environment variable.
+
=head1 DOCUMENTATION
Read the manual entries before running perl. The main documentation
diff --git a/MANIFEST b/MANIFEST
index 29366ab15d..c0ca549c13 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -6175,7 +6175,8 @@ t/run/fresh_perl.t Tests that require a fresh perl.
t/run/locale.t Tests related to locale handling
t/run/noswitch.t Test aliasing ARGV for other switch tests
t/run/runenv.t Test if perl honors its environment variables.
-t/run/runenv_hashseed.t Test if perl honors PERL_HASH_SEED.
+t/run/runenv_hashseed.t Test if perl honors PERL_HASH_SEED.
+t/run/runenv_randseed.t Test if perl honors PERL_RAND_SEED.
t/run/script.t See if script invocation works
t/run/switch0.t Test the -0 switch
t/run/switcha.t Test the -a switch
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 */
diff --git a/embedvar.h b/embedvar.h
index 927a6e5d5f..7f872368bd 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -280,6 +280,8 @@
#define PL_sortstash (vTHX->Isortstash)
#define PL_splitstr (vTHX->Isplitstr)
#define PL_srand_called (vTHX->Isrand_called)
+#define PL_srand_override (vTHX->Isrand_override)
+#define PL_srand_override_next (vTHX->Isrand_override_next)
#define PL_stack_base (vTHX->Istack_base)
#define PL_stack_max (vTHX->Istack_max)
#define PL_stack_sp (vTHX->Istack_sp)
diff --git a/handy.h b/handy.h
index 38619df32b..ed32a180c8 100644
--- a/handy.h
+++ b/handy.h
@@ -2967,21 +2967,75 @@ last-inclusive range.
* are very useful when you want an integer to "dance" in a random way,
* but you also never want it to become 0 and thus false.
*
- * Obviously they leave x unchanged if it starts out as 0. */
+ * Obviously they leave x unchanged if it starts out as 0.
+ *
+ * We have two variants just because that can be helpful in certain
+ * places. There is no advantage to either, they are equally bad as each
+ * other as far RNG's go. Sufficiently random for many purposes, but
+ * insufficiently random for serious use as they fail important tests in
+ * the Test01 BigCrush RNG test suite by L’Ecuyer and Simard. (Note
+ * that Drand48 also fails BigCrush). The main point is they produce
+ * different sequences and in places where we want some randomlike
+ * behavior they are cheap and easy.
+ *
+ * Marsaglia was one of the early researchers into RNG testing and wrote
+ * the Diehard RNG test suite, which after his death become the
+ * Dieharder RNG suite, and was generally supplanted by the Test01 suite
+ * by L'Ecruyer and associates.
+ *
+ * There are dozens of shift parameters that create a pseudo random ring
+ * of integers 1..2^N-1, if you need a different sequence just read the
+ * paper and select a set of parameters. In fact, simply reversing the
+ * shift order from L/R/L to R/L/R should result in another valid
+ * example, but read the paper before you do that.
+ *
+ * PDF of the original paper:
+ * https://www.jstatsoft.org/article/download/v008i14/916
+ * Wikipedia:
+ * https://en.wikipedia.org/wiki/Xorshift
+ * Criticism:
+ * https://www.iro.umontreal.ca/~lecuyer/myftp/papers/xorshift.pdf
+ * Test01:
+ * http://simul.iro.umontreal.ca/testu01/tu01.html
+ * Diehard:
+ * https://en.wikipedia.org/wiki/Diehard_tests
+ * Dieharder:
+ * https://webhome.phy.duke.edu/~rgb/General/rand_rate/rand_rate.abs
+ *
+ */
-#define PERL_XORSHIFT64(x) \
+/* 32 bit version */
+#define PERL_XORSHIFT32_A(x) \
STMT_START { \
- (x) ^= (x) << 13; \
- (x) ^= (x) >> 17; \
- (x) ^= (x) << 5; \
+ (x) ^= ((x) << 13); \
+ (x) ^= ((x) >> 17); \
+ (x) ^= ((x) << 5); \
+} STMT_END
+
+/* 64 bit version */
+#define PERL_XORSHIFT64_A(x) \
+STMT_START { \
+ (x) ^= ((x) << 13); \
+ (x) ^= ((x) >> 7); \
+ (x) ^= ((x) << 17); \
} STMT_END
/* 32 bit version */
-#define PERL_XORSHIFT32(x) \
+#define PERL_XORSHIFT32_B(x) \
+STMT_START { \
+ (x) ^= ((x) << 5); \
+ (x) ^= ((x) >> 27); \
+ (x) ^= ((x) << 8); \
+} STMT_END
+
+/* 64 bit version - currently this is unused,
+ * it is provided here to complement the 32 bit _B
+ * variant which IS used. */
+#define PERL_XORSHIFT64_B(x) \
STMT_START { \
- (x) ^= (x) << 13; \
- (x) ^= (x) >> 7; \
- (x) ^= (x) << 17; \
+ (x) ^= ((x) << 15); \
+ (x) ^= ((x) >> 49); \
+ (x) ^= ((x) << 26); \
} STMT_END
diff --git a/hv.c b/hv.c
index 0bfe207dab..7ab14a84f7 100644
--- a/hv.c
+++ b/hv.c
@@ -56,10 +56,10 @@ static const char S_strtab_error[]
*/
#if IVSIZE == 8
/* 64 bit version */
-#define XORSHIFT_RAND_BITS(x) PERL_XORSHIFT64(x)
+#define XORSHIFT_RAND_BITS(x) PERL_XORSHIFT64_A(x)
#else
/* 32 bit version */
-#define XORSHIFT_RAND_BITS(x) PERL_XORSHIFT32(x)
+#define XORSHIFT_RAND_BITS(x) PERL_XORSHIFT32_A(x)
#endif
#define UPDATE_HASH_RAND_BITS_KEY(key,klen) \
diff --git a/intrpvar.h b/intrpvar.h
index 58e9ef9a23..ac912acd5a 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -810,7 +810,9 @@ PERLVARI(I, perl_destruct_level, signed char, 0)
PERLVAR(I, pad_reset_pending, bool) /* reset pad on next attempted alloc */
-PERLVAR(I, srand_called, bool)
+PERLVARI(I, srand_called, bool, false) /* has random_state been initialized yet? */
+PERLVARI(I, srand_override, U32, 0) /* Should we use a deterministic sequence? */
+PERLVARI(I, srand_override_next, U32, 0) /* Next item in the sequence */
PERLVARI(I, numeric_underlying, bool, TRUE)
/* Assume underlying locale numerics */
diff --git a/perl.c b/perl.c
index 873c27b6f7..86b83ca403 100644
--- a/perl.c
+++ b/perl.c
@@ -266,20 +266,43 @@ perl_construct(pTHXx)
init_stacks();
-/* The PERL_INTERNAL_RAND_SEED set-up must be after init_stacks because it calls
+#if !defined(NO_PERL_RAND_SEED) || !defined(NO_PERL_INTERNAL_HASH_SEED)
+ bool sensitive_env_vars_allowed =
+ (PerlProc_getuid() == PerlProc_geteuid() &&
+ PerlProc_getgid() == PerlProc_getegid()) ? TRUE : FALSE;
+#endif
+
+/* The seed set-up must be after init_stacks because it calls
* things that may put SVs on the stack.
*/
+#ifndef NO_PERL_RAND_SEED
+ if (sensitive_env_vars_allowed) {
+ UV seed= 0;
+ const char *env_pv;
+ if ((env_pv = PerlEnv_getenv("PERL_RAND_SEED")) &&
+ grok_number(env_pv, strlen(env_pv), &seed) == IS_NUMBER_IN_UV)
+ {
+ PL_srand_override_next = seed;
+ PERL_SRAND_OVERRIDE_NEXT_INIT();
+ }
+ }
+#endif
+
+ /* This is NOT the state used for C<rand()>, this is only
+ * used in internal functionality */
#ifdef NO_PERL_INTERNAL_RAND_SEED
Perl_drand48_init_r(&PL_internal_random_state, seed());
#else
{
UV seed;
const char *env_pv;
- if (PerlProc_getuid() != PerlProc_geteuid() ||
- PerlProc_getgid() != PerlProc_getegid() ||
+ if (
+ !sensitive_env_vars_allowed ||
!(env_pv = PerlEnv_getenv("PERL_INTERNAL_RAND_SEED")) ||
- grok_number(env_pv, strlen(env_pv), &seed) != IS_NUMBER_IN_UV) {
+ grok_number(env_pv, strlen(env_pv), &seed) != IS_NUMBER_IN_UV)
+ {
+ /* use a randomly generated seed */
seed = seed();
}
Perl_drand48_init_r(&PL_internal_random_state, (U32)seed);
@@ -2038,6 +2061,12 @@ S_Internals_V(pTHX_ CV *cv)
# ifdef USE_THREAD_SAFE_LOCALE
" USE_THREAD_SAFE_LOCALE"
# endif
+# ifdef NO_PERL_RAND_SEED
+ " NO_PERL_RAND_SEED"
+# endif
+# ifdef NO_PERL_INTERNAL_RAND_SEED
+ " NO_PERL_INTERNAL_RAND_SEED"
+# endif
;
PERL_UNUSED_ARG(cv);
PERL_UNUSED_VAR(items);
diff --git a/perl.h b/perl.h
index 058d5693bc..5966de0f87 100644
--- a/perl.h
+++ b/perl.h
@@ -8806,8 +8806,31 @@ END_EXTERN_C
# endif
#endif
-#endif /* DOUBLE_HAS_NAN */
+/* these are used to faciliate the env var PERL_RAND_SEED,
+ * which allows consistent behavior from code that calls
+ * srand() with no arguments, either explicitly or implicitly.
+ */
+#define PERL_SRAND_OVERRIDE_NEXT() PERL_XORSHIFT32_A(PL_srand_override_next);
+
+#define PERL_SRAND_OVERRIDE_NEXT_INIT() STMT_START { \
+ PL_srand_override = PL_srand_override_next; \
+ PERL_SRAND_OVERRIDE_NEXT(); \
+} STMT_END
+
+#define PERL_SRAND_OVERRIDE_GET(into) STMT_START { \
+ into= PL_srand_override; \
+ PERL_SRAND_OVERRIDE_NEXT_INIT(); \
+} STMT_END
+#define PERL_SRAND_OVERRIDE_NEXT_CHILD() STMT_START { \
+ PERL_XORSHIFT32_B(PL_srand_override_next); \
+ PERL_SRAND_OVERRIDE_NEXT_INIT(); \
+} STMT_END
+
+#define PERL_SRAND_OVERRIDE_NEXT_PARENT() \
+ PERL_SRAND_OVERRIDE_NEXT()
+
+#endif /* DOUBLE_HAS_NAN */
/*
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index a5b6347a6e..5120e3125b 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -27,6 +27,17 @@ here, but most should go in the L</Performance Enhancements> section.
[ List each enhancement as a =head2 entry ]
+=head2 PERL_RAND_SEED
+
+Added a new environment variable C<PERL_RAND_SEED> which can be used to
+cause a perl program which uses C<rand> without using C<srand()>
+explicitly or which uses C<srand()> with no arguments to be repeatable.
+See L<perlrun>. This feature can be disabled at compile time by passing
+
+ -Accflags=-DNO_PERL_RAND_SEED
+
+to F<Configure> during the build process.
+
=head1 Security
XXX Any security-related notices go here. In particular, any security
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 38ebb0d12d..fa16cbd69c 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -8480,7 +8480,7 @@ The point of the function is to "seed" the L<C<rand>|/rand EXPR>
function so that L<C<rand>|/rand EXPR> can produce a different sequence
each time you run your program. When called with a parameter,
L<C<srand>|/srand EXPR> uses that for the seed; otherwise it
-(semi-)randomly chooses a seed. In either case, starting with Perl 5.14,
+(semi-)randomly chooses a seed (see below). In either case, starting with Perl 5.14,
it returns the seed. To signal that your code will work I<only> on Perls
of a recent vintage:
@@ -8512,6 +8512,20 @@ combinations to test comprehensively in the time available to it each run. It
can test a random subset each time, and should there be a failure, log the seed
used for that run so that it can later be used to reproduce the same results.
+If the C<PERL_RAND_SEED> environment variable is set to a non-negative
+integer during process startup then calls to C<srand()> with no
+arguments will initialize the perl random number generator with a
+consistent seed each time it is called, whether called explicitly with
+no arguments or implicitly via use of C<rand()>. The exact seeding that
+a given C<PERL_RAND_SEED> will produce is deliberately unspecified, but
+using different values for C<PERL_RAND_SEED> should produce different
+results. This is intended for debugging and performance analysis and is
+only guaranteed to produce consistent results between invocations of the
+same perl executable running the same code when all other factors are
+equal. The environment variable is read only once during process
+startup, and changing it during the program flow will not affect the
+currently running process. See L<perlrun> for more details.
+
B<L<C<rand>|/rand EXPR> is not cryptographically secure. You should not rely
on it in security-sensitive situations.> As of this writing, a
number of third-party CPAN modules offer random number generators
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 0b5a6d3875..6ed5703811 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -1405,6 +1405,32 @@ with tainting enabled.
Perl may be built to ignore this variable.
+=item PERL_RAND_SEED
+X<PERL_RAND_SEED>
+
+When set to an integer value this value will be used to seed the perl
+internal random number generator used for C<rand()> when it is used
+without an explicit C<srand()> call or for when an explicit no-argument
+C<srand()> call is made.
+
+Normally calling C<rand()> prior to calling C<srand()> or calling
+C<srand()> explicitly with no arguments should result in the random
+number generator using "best efforts" to seed the generator state with a
+relatively high quality random seed. When this environment variable is
+set then the seeds used will be deterministically computed from the
+value provided in the env var in such a way that the application process
+and any forks or threads should continue to have their own unique seed but
+that the program may be run twice with identical results as far as
+C<rand()> goes (assuming all else is equal).
+
+PERL_RAND_SEED is intended for performance measurements and debugging
+and is explicitly NOT intended for stable testing. The only guarantee is
+that a specific perl executable will produce the same results twice in a
+row, there is no guarantee that the results will be the same between
+perl releases or on different architectures.
+
+Ignored if perl is run setuid or setgid.
+
=back
Perl also has environment variables that control how Perl handles data
diff --git a/pp.c b/pp.c
index 2f88019aca..20df361f74 100644
--- a/pp.c
+++ b/pp.c
@@ -2920,7 +2920,17 @@ PP(pp_sin)
PP(pp_rand)
{
if (!PL_srand_called) {
- (void)seedDrand01((Rand_seed_t)seed());
+ Rand_seed_t s;
+ if (PL_srand_override) {
+ /* env var PERL_RAND_SEED has been set so the user wants
+ * consistent srand() initialization. */
+ PERL_SRAND_OVERRIDE_GET(s);
+ } else {
+ /* Pseudo random initialization from context state and possible
+ * random devices */
+ s= (Rand_seed_t)seed();
+ }
+ (void)seedDrand01(s);
PL_srand_called = TRUE;
}
{
@@ -2979,7 +2989,13 @@ PP(pp_srand)
}
}
else {
- anum = seed();
+ if (PL_srand_override) {
+ /* env var PERL_RAND_SEED has been set so the user wants
+ * consistent srand() initialization. */
+ PERL_SRAND_OVERRIDE_GET(anum);
+ } else {
+ anum = seed();
+ }
}
(void)seedDrand01((Rand_seed_t)anum);
diff --git a/pp_sys.c b/pp_sys.c
index 729371813e..48ad17df80 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4232,6 +4232,7 @@ PP(pp_fork)
sigset_t oldmask, newmask;
#endif
+
EXTEND(SP, 1);
PERL_FLUSHALL_FOR_CHILD;
#ifdef HAS_SIGPROCMASK
@@ -4259,6 +4260,9 @@ PP(pp_fork)
#ifdef PERL_USES_PL_PIDSTATUS
hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
#endif
+ PERL_SRAND_OVERRIDE_NEXT_CHILD();
+ } else {
+ PERL_SRAND_OVERRIDE_NEXT_PARENT();
}
PUSHi(childpid);
RETURN;
@@ -4271,6 +4275,19 @@ PP(pp_fork)
childpid = PerlProc_fork();
if (childpid == -1)
RETPUSHUNDEF;
+ else if (childpid) {
+ /* we are in the parent */
+ PERL_SRAND_OVERRIDE_NEXT_PARENT();
+ }
+ else {
+ /* This is part of the logic supporting the env var
+ * PERL_RAND_SEED which causes use of rand() without an
+ * explicit srand() to use a deterministic seed. This logic is
+ * intended to give most forked children of a process a
+ * deterministic but different srand seed.
+ */
+ PERL_SRAND_OVERRIDE_NEXT_CHILD();
+ }
PUSHi(childpid);
RETURN;
#else
diff --git a/sv.c b/sv.c
index bb30c91937..6ffca6678c 100644
--- a/sv.c
+++ b/sv.c
@@ -15544,6 +15544,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_srand_called = proto_perl->Isrand_called;
Copy(&(proto_perl->Irandom_state), &PL_random_state, 1, PL_RANDOM_STATE_TYPE);
+ PL_srand_override = proto_perl->Isrand_override;
+ PL_srand_override_next = proto_perl->Isrand_override_next;
if (flags & CLONEf_COPY_STACKS) {
/* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
diff --git a/t/op/srand.t b/t/op/srand.t
index 09de60aa22..47f7590812 100644
--- a/t/op/srand.t
+++ b/t/op/srand.t
@@ -52,9 +52,12 @@ ok( !eq_array(\@first_run, \@second_run),
}
# This test checks whether Perl called srand for you.
-@first_run = `$^X -le "print int rand 100 for 1..100"`;
-sleep(1); # in case our srand() is too time-dependent
-@second_run = `$^X -le "print int rand 100 for 1..100"`;
+{
+ local $ENV{PERL_RAND_SEED};
+ @first_run = `$^X -le "print int rand 100 for 1..100"`;
+ sleep(1); # in case our srand() is too time-dependent
+ @second_run = `$^X -le "print int rand 100 for 1..100"`;
+}
ok( !eq_array(\@first_run, \@second_run), 'srand() called automatically');
diff --git a/t/run/runenv_randseed.t b/t/run/runenv_randseed.t
new file mode 100644
index 0000000000..b0ec6072b8
--- /dev/null
+++ b/t/run/runenv_randseed.t
@@ -0,0 +1,68 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+ require Config;
+ Config->import;
+}
+
+skip_all_without_config('d_fork');
+skip_all("This perl is built with NO_PERL_RAND_SEED")
+ if $Config{ccflags} =~ /-DNO_PERL_RAND_SEED\b/;
+use strict;
+use warnings;
+
+for (1..2) {
+ local $ENV{PERL_RAND_SEED} = 1;
+ fresh_perl_is("print map { chr(rand(26)+65) } 1..10",
+ "BLVIOAEZTJ", undef, "Test randomness with PERL_RAND_SEED=1");
+}
+
+for (1..2) {
+ local $ENV{PERL_RAND_SEED} = 2;
+ fresh_perl_is("print map { chr(rand(26)+65) } 1..10",
+ "XEOUOFRPQZ", undef, "Test randomness with PERL_RAND_SEED=2");
+}
+
+my %got;
+for my $try (1..10) {
+ local $ENV{PERL_RAND_SEED};
+ my ($out,$err)= runperl_and_capture({}, ['-e',"print map { chr(rand(26)+65) } 1..10;"]);
+ if ($err) { diag $err }
+ $got{$out}++;
+}
+ok(8 <= keys %got, "Got at least 8 different strings");
+for (1..2) {
+ local $ENV{PERL_RAND_SEED} = 1;
+ my ($out,$err)= runperl_and_capture({}, ['-le',
+ <<'EOF_TEST_CODE'
+ for my $l ("A".."E") {
+ my $pid= fork;
+ if ($pid) {
+ push @pids, $pid;
+ }
+ elsif (!defined $pid) {
+ print "$l:failed fork";
+ } elsif (!$pid) {
+ print "$l:", map { chr(rand(26)+65) } 1..10;
+ exit;
+ }
+ }
+ waitpid $_,0 for @pids;
+EOF_TEST_CODE
+ ]);
+ is($err, "", "No exceptions forking.");
+ my @parts= sort { $a cmp $b } split /\n/, $out;
+ my @want= (
+ "A:KNXDITWWJZ",
+ "B:WDQJGTBJQS",
+ "C:ZGYCCINIHE",
+ "D:UGLGAEXFBP",
+ "E:MQLTNZGZQB"
+ );
+ is("@parts","@want","Works as expected with forks.");
+}
+
+done_testing();