1#!./perl -w 2 3BEGIN { 4 chdir "t" if -d "t"; 5 require "./test.pl"; 6 set_up_inc( qw(. ../lib) ); 7} 8 9# Test srand. 10 11use strict; 12 13plan(tests => 10); 14 15# Generate a load of random numbers. 16# int() avoids possible floating point error. 17sub mk_rand { map int rand 10000, 1..100; } 18 19 20# Check that rand() is deterministic. 21srand(1138); 22my @first_run = mk_rand; 23 24srand(1138); 25my @second_run = mk_rand; 26 27ok( eq_array(\@first_run, \@second_run), 'srand(), same arg, same rands' ); 28 29 30# Check that different seeds provide different random numbers 31srand(31337); 32@first_run = mk_rand; 33 34srand(1138); 35@second_run = mk_rand; 36 37ok( !eq_array(\@first_run, \@second_run), 38 'srand(), different arg, different rands' ); 39 40 41# Check that srand() isn't affected by $_ 42{ 43 local $_ = 42; 44 srand(); 45 @first_run = mk_rand; 46 47 srand(42); 48 @second_run = mk_rand; 49 50 ok( !eq_array(\@first_run, \@second_run), 51 'srand(), no arg, not affected by $_'); 52} 53 54# This test checks whether Perl called srand for you. 55{ 56 local $ENV{PERL_RAND_SEED}; 57 @first_run = `$^X -le "print int rand 100 for 1..100"`; 58 sleep(1); # in case our srand() is too time-dependent 59 @second_run = `$^X -le "print int rand 100 for 1..100"`; 60} 61 62ok( !eq_array(\@first_run, \@second_run), 'srand() called automatically'); 63 64# check srand's return value 65my $seed = srand(1764); 66is( $seed, 1764, "return value" ); 67 68$seed = srand(0); 69ok( $seed, "true return value for srand(0)"); 70cmp_ok( $seed, '==', 0, "numeric 0 return value for srand(0)"); 71 72{ 73 my @warnings; 74 my $b; 75 { 76 local $SIG{__WARN__} = sub { 77 push @warnings, "@_"; 78 warn @_; 79 }; 80 $b = $seed + 0; 81 } 82 is( $b, 0, "Quacks like a zero"); 83 is( "@warnings", "", "Does not warn"); 84} 85 86# [perl #40605] 87{ 88 use warnings; 89 my $w = ''; 90 local $SIG{__WARN__} = sub { $w .= $_[0] }; 91 srand(2**100); 92 like($w, qr/^Integer overflow in srand at /, "got a warning"); 93} 94