t/op/srand.t

   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 }