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