cleanup and test PERL_PERTURB_KEYS environment variable handling

1 files changed, 48 insertions, 1 deletions

diff --git a/t/run/runenv.t b/t/run/runenv.t
index a52b5eeb46..b3df796dd1 100644
--- a/t/run/runenv.t
+++ b/t/run/runenv.t
@@ -12,7 +12,7 @@ BEGIN {
     skip_all_without_config('d_fork');
 }
 
-plan tests => 94;
+plan tests => 104;
 
 my $STDOUT = tempfile();
 my $STDERR = tempfile();
@@ -214,6 +214,34 @@ try({PERL_HASH_SEED_DEBUG => 1},
     '',
     qr/HASH_SEED =/);
 
+# special case, seed "0" implies disabled hash key traversal randomization
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 0/);
+
+# check that setting it to a different value with the same logical value
+# triggers the normal "deterministic mode".
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0x0"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 2/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "0"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 0/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "1"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 1/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "2"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 2/);
+
 try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12345678"},
     ['-e','1'],
     '',
@@ -228,6 +256,25 @@ try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "123456789"},
     ['-e','1'],
     '',
     qr/HASH_SEED = 0x12345678/);
+
+# Test that PERL_PERTURB_KEYS works as expected.  We check that we get the same
+# results if we use PERL_PERTURB_KEYS = 0 or 2 and we reuse the seed from previous run.
+my @print_keys = ( '-e', '@_{"A".."Z"}=(); print keys %_');
+for my $mode ( 0,1, 2 ) { # disabled and deterministic respectively
+    my %base_opts = ( PERL_PERTURB_KEYS => $mode, PERL_HASH_SEED_DEBUG => 1 ),
+    my ($out, $err) = runperl_and_capture( { %base_opts }, [ @print_keys ]);
+    if ($err=~/HASH_SEED = (0x[a-f0-9]+)/) {
+        my $seed = $1;
+        my($out2, $err2) = runperl_and_capture( { %base_opts, PERL_HASH_SEED => $seed }, [ @print_keys ]);
+        if ( $mode == 1 ) {
+            isnt ($out,$out2,"PERL_PERTURB_KEYS = $mode results in different key order with the same key");
+        } else {
+            is ($out,$out2,"PERL_PERTURB_KEYS = $mode allows one to recreate a random hash");
+        }
+        is ($err,$err2,"Got the same debug output when we set PERL_HASH_SEED and PERL_PERTURB_KEYS");
+    }
+}
+
 # Tests for S_incpush_use_sep():
 
 my @dump_inc = ('-e', 'print "$_\n" foreach @INC');