@@ -204,74 +204,87 @@ try({PERL5LIB => "foo",
204
204
' ' ,
205
205
' ' );
206
206
207
- try({PERL_HASH_SEED_DEBUG => 1},
208
- [' -e' ,' 1' ],
209
- ' ' ,
210
- qr / HASH_FUNCTION =/ );
211
-
212
- try({PERL_HASH_SEED_DEBUG => 1},
213
- [' -e' ,' 1' ],
214
- ' ' ,
215
- qr / HASH_SEED =/ );
216
-
217
- # special case, seed "0" implies disabled hash key traversal randomization
218
- try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 0" },
219
- [' -e' ,' 1' ],
220
- ' ' ,
221
- qr / PERTURB_KEYS = 0/ );
222
-
223
- # check that setting it to a different value with the same logical value
224
- # triggers the normal "deterministic mode".
225
- try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 0x0" },
226
- [' -e' ,' 1' ],
227
- ' ' ,
228
- qr / PERTURB_KEYS = 2/ );
229
-
230
- try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => " 0" },
231
- [' -e' ,' 1' ],
232
- ' ' ,
233
- qr / PERTURB_KEYS = 0/ );
234
-
235
- try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => " 1" },
236
- [' -e' ,' 1' ],
237
- ' ' ,
238
- qr / PERTURB_KEYS = 1/ );
239
-
240
- try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => " 2" },
241
- [' -e' ,' 1' ],
242
- ' ' ,
243
- qr / PERTURB_KEYS = 2/ );
244
-
245
- try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 12345678" },
246
- [' -e' ,' 1' ],
247
- ' ' ,
248
- qr / HASH_SEED = 0x12345678/ );
249
-
250
- try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 12" },
251
- [' -e' ,' 1' ],
252
- ' ' ,
253
- qr / HASH_SEED = 0x12000000/ );
207
+ SKIP:
208
+ {
209
+ skip " NO_PERL_HASH_SEED_DEBUG set" , 4
210
+ if $Config {ccflags } =~ / -DNO_PERL_HASH_SEED_DEBUG\b / ;
211
+
212
+ try({PERL_HASH_SEED_DEBUG => 1},
213
+ [' -e' ,' 1' ],
214
+ ' ' ,
215
+ qr / HASH_FUNCTION =/ );
216
+
217
+ try({PERL_HASH_SEED_DEBUG => 1},
218
+ [' -e' ,' 1' ],
219
+ ' ' ,
220
+ qr / HASH_SEED =/ );
221
+ }
254
222
255
- try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 123456789" },
256
- [' -e' ,' 1' ],
257
- ' ' ,
258
- qr / HASH_SEED = 0x12345678/ );
259
-
260
- # Test that PERL_PERTURB_KEYS works as expected. We check that we get the same
261
- # results if we use PERL_PERTURB_KEYS = 0 or 2 and we reuse the seed from previous run.
262
- my @print_keys = ( ' -e' , ' @_{"A".."Z"}=(); print keys %_' );
263
- for my $mode ( 0,1, 2 ) { # disabled and deterministic respectively
264
- my %base_opts = ( PERL_PERTURB_KEYS => $mode , PERL_HASH_SEED_DEBUG => 1 ),
265
- my ($out , $err ) = runperl_and_capture( { %base_opts }, [ @print_keys ]);
266
- if ($err =~/ HASH_SEED = (0x[a-f0-9]+)/ ) {
267
- my $seed = $1 ;
268
- my ($out2 , $err2 ) = runperl_and_capture( { %base_opts , PERL_HASH_SEED => $seed }, [ @print_keys ]);
269
- if ( $mode == 1 ) {
270
- isnt ($out ,$out2 ," PERL_PERTURB_KEYS = $mode results in different key order with the same key" );
271
- } else {
272
- is ($out ,$out2 ," PERL_PERTURB_KEYS = $mode allows one to recreate a random hash" );
223
+ SKIP:
224
+ {
225
+ skip " NO_PERL_HASH_ENV or NO_PERL_HASH_SEED_DEBUG set" , 16
226
+ if $Config {ccflags } =~ / -DNO_PERL_HASH_ENV\b / ||
227
+ $Config {ccflags } =~ / -DNO_PERL_HASH_SEED_DEBUG\b / ;
228
+
229
+ # special case, seed "0" implies disabled hash key traversal randomization
230
+ try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 0" },
231
+ [' -e' ,' 1' ],
232
+ ' ' ,
233
+ qr / PERTURB_KEYS = 0/ );
234
+
235
+ # check that setting it to a different value with the same logical value
236
+ # triggers the normal "deterministic mode".
237
+ try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 0x0" },
238
+ [' -e' ,' 1' ],
239
+ ' ' ,
240
+ qr / PERTURB_KEYS = 2/ );
241
+
242
+ try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => " 0" },
243
+ [' -e' ,' 1' ],
244
+ ' ' ,
245
+ qr / PERTURB_KEYS = 0/ );
246
+
247
+ try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => " 1" },
248
+ [' -e' ,' 1' ],
249
+ ' ' ,
250
+ qr / PERTURB_KEYS = 1/ );
251
+
252
+ try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => " 2" },
253
+ [' -e' ,' 1' ],
254
+ ' ' ,
255
+ qr / PERTURB_KEYS = 2/ );
256
+
257
+ try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 12345678" },
258
+ [' -e' ,' 1' ],
259
+ ' ' ,
260
+ qr / HASH_SEED = 0x12345678/ );
261
+
262
+ try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 12" },
263
+ [' -e' ,' 1' ],
264
+ ' ' ,
265
+ qr / HASH_SEED = 0x12000000/ );
266
+
267
+ try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => " 123456789" },
268
+ [' -e' ,' 1' ],
269
+ ' ' ,
270
+ qr / HASH_SEED = 0x12345678/ );
271
+
272
+ # Test that PERL_PERTURB_KEYS works as expected. We check that we get the same
273
+ # results if we use PERL_PERTURB_KEYS = 0 or 2 and we reuse the seed from previous run.
274
+ my @print_keys = ( ' -e' , ' @_{"A".."Z"}=(); print keys %_' );
275
+ for my $mode ( 0,1, 2 ) { # disabled and deterministic respectively
276
+ my %base_opts = ( PERL_PERTURB_KEYS => $mode , PERL_HASH_SEED_DEBUG => 1 ),
277
+ my ($out , $err ) = runperl_and_capture( { %base_opts }, [ @print_keys ]);
278
+ if ($err =~/ HASH_SEED = (0x[a-f0-9]+)/ ) {
279
+ my $seed = $1 ;
280
+ my ($out2 , $err2 ) = runperl_and_capture( { %base_opts , PERL_HASH_SEED => $seed }, [ @print_keys ]);
281
+ if ( $mode == 1 ) {
282
+ isnt ($out ,$out2 ," PERL_PERTURB_KEYS = $mode results in different key order with the same key" );
283
+ } else {
284
+ is ($out ,$out2 ," PERL_PERTURB_KEYS = $mode allows one to recreate a random hash" );
285
+ }
286
+ is ($err ,$err2 ," Got the same debug output when we set PERL_HASH_SEED and PERL_PERTURB_KEYS" );
273
287
}
274
- is ($err ,$err2 ," Got the same debug output when we set PERL_HASH_SEED and PERL_PERTURB_KEYS" );
275
288
}
276
289
}
277
290
0 commit comments