t/op/rand.t

   1 #!./perl
   2
   3 # From Tom Phoenix <rootbeer@teleport.com> 22 Feb 1997
   4 # Based upon a test script by kgb@ast.cam.ac.uk (Karl Glazebrook)
   5
   6 # Looking for the hints? You're in the right place.
   7 # The hints are near each test, so search for "TEST #", where
   8 # the pound sign is replaced by the number of the test.
   9
  10 # I'd like to include some more robust tests, but anything
  11 # too subtle to be detected here would require a time-consuming
  12 # test. Also, of course, we're here to detect only flaws in Perl;
  13 # if there are flaws in the underlying system rand, that's not
  14 # our responsibility. But if you want better tests, see
  15 # The Art of Computer Programming, Donald E. Knuth, volume 2,
  16 # chapter 3. ISBN 0-201-03822-6 (v. 2)
  17
  18 BEGIN {
  19     chdir "t" if -d "t";
  20     @INC = '../lib';
  21 }
  22
  23 use strict;
  24 use Config;
  25 use Test::More tests => 8;
  26
  27
  28 my $reps = 10000;       # How many times to try rand each time.
  29                         # May be changed, but should be over 500.
  30                         # The more the better! (But slower.)
  31
  32 sub bits ($) {
  33     # Takes a small integer and returns the number of one-bits in it.
  34     my $total;
  35     my $bits = sprintf "%o", $_[0];
  36     while (length $bits) {
  37         $total += (0,1,1,2,1,2,2,3)[chop $bits];        # Oct to bits
  38     }
  39     $total;
  40 }
  41
  42 # First, let's see whether randbits is set right
  43 {
  44     my($max, $min, $sum);       # Characteristics of rand
  45     my($off, $shouldbe);        # Problems with randbits
  46     my($dev, $bits);            # Number of one bits
  47     my $randbits = $Config{randbits};
  48     $max = $min = rand(1);
  49     for (1..$reps) {
  50         my $n = rand(1);
  51         if ($n < 0.0 or $n >= 1.0) {
  52             print <<EOM;
  53 # WHOA THERE!  \$Config{drand01} is set to '$Config{drand01}',
  54 # but that apparently produces values < 0.0 or >= 1.0.
  55 # Make sure \$Config{drand01} is a valid expression in the
  56 # C-language, and produces values in the range [0.0,1.0).
  57 #
  58 # I give up.
  59 EOM
  60             exit;
  61         }
  62         $sum += $n;
  63         $bits += bits($n * 256);        # Don't be greedy; 8 is enough
  64                     # It's too many if randbits is less than 8!
  65                     # But that should never be the case... I hope.
  66                     # Note: If you change this, you must adapt the
  67                     # formula for absolute standard deviation, below.
  68         $max = $n if $n > $max;
  69         $min = $n if $n < $min;
  70     }
  71
  72
  73     # This test checks for one of Perl's most frequent
  74     # mis-configurations. Your system's documentation
  75     # for rand(2) should tell you what value you need
  76     # for randbits. Usually the diagnostic message
  77     # has the right value as well. Just fix it and
  78     # recompile, and you'll usually be fine. (The main
  79     # reason that the diagnostic message might get the
  80     # wrong value is that Config.pm is incorrect.)
  81     #
  82     unless (ok( !$max <= 0 or $max >= (2 ** $randbits))) {# Just in case...
  83         print <<DIAG;
  84 # max=[$max] min=[$min]
  85 # This perl was compiled with randbits=$randbits
  86 # which is _way_ off. Or maybe your system rand is broken,
  87 # or your C compiler can't multiply, or maybe Martians
  88 # have taken over your computer. For starters, see about
  89 # trying a better value for randbits, probably smaller.
  90 DIAG
  91
  92         # If that isn't the problem, we'll have
  93         # to put d_martians into Config.pm
  94         print "# Skipping remaining tests until randbits is fixed.\n";
  95         exit;
  96     }
  97
  98     $off = log($max) / log(2);                  # log2
  99     $off = int($off) + ($off > 0);              # Next more positive int
 100     unless (is( $off, 0 )) {
 101         $shouldbe = $Config{randbits} + $off;
 102         print "# max=[$max] min=[$min]\n";
 103         print "# This perl was compiled with randbits=$randbits on $^O.\n";
 104         print "# Consider using randbits=$shouldbe instead.\n";
 105         # And skip the remaining tests; they would be pointless now.
 106         print "# Skipping remaining tests until randbits is fixed.\n";
 107         exit;
 108     }
 109
 110
 111     # This should always be true: 0 <= rand(1) < 1
 112     # If this test is failing, something is seriously wrong,
 113     # either in perl or your system's rand function.
 114     #
 115     unless (ok( !($min < 0 or $max >= 1) )) {   # Slightly redundant...
 116         print "# min too low\n" if $min < 0;
 117         print "# max too high\n" if $max >= 1;
 118     }
 119
 120
 121     # This is just a crude test. The average number produced
 122     # by rand should be about one-half. But once in a while
 123     # it will be relatively far away. Note: This test will
 124     # occasionally fail on a perfectly good system!
 125     # See the hints for test 4 to see why.
 126     #
 127     $sum /= $reps;
 128     unless (ok( !($sum < 0.4 or $sum > 0.6) )) {
 129         print "# Average random number is far from 0.5\n";
 130     }
 131
 132
 133     #   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
 134     # This test will fail .1% of the time on a normal system.
 135     #                           also
 136     # This test asks you to see these hints 100% of the time!
 137     #   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
 138     #
 139     # There is probably no reason to be alarmed that
 140     # something is wrong with your rand function. But,
 141     # if you're curious or if you can't help being
 142     # alarmed, keep reading.
 143     #
 144     # This is a less-crude test than test 3. But it has
 145     # the same basic flaw: Unusually distributed random
 146     # values should occasionally appear in every good
 147     # random number sequence. (If you flip a fair coin
 148     # twenty times every day, you'll see it land all
 149     # heads about one time in a million days, on the
 150     # average. That might alarm you if you saw it happen
 151     # on the first day!)
 152     #
 153     # So, if this test failed on you once, run it a dozen
 154     # times. If it keeps failing, it's likely that your
 155     # rand is bogus. If it keeps passing, it's likely
 156     # that the one failure was bogus. If it's a mix,
 157     # read on to see about how to interpret the tests.
 158     #
 159     # The number printed in square brackets is the
 160     # standard deviation, a statistical measure
 161     # of how unusual rand's behavior seemed. It should
 162     # fall in these ranges with these *approximate*
 163     # probabilities:
 164     #
 165     #           under 1         68.26% of the time
 166     #           1-2             27.18% of the time
 167     #           2-3              4.30% of the time
 168     #           over 3           0.26% of the time
 169     #
 170     # If the numbers you see are not scattered approximately
 171     # (not exactly!) like that table, check with your vendor
 172     # to find out what's wrong with your rand. Or with this
 173     # algorithm. :-)
 174     #
 175     # Calculating absoulute standard deviation for number of bits set
 176     # (eight bits per rep)
 177     $dev = abs ($bits - $reps * 4) / sqrt($reps * 2);
 178
 179     ok( $dev < 3.3 );
 180
 181     if ($dev < 1.96) {
 182         print "# Your rand seems fine. If this test failed\n";
 183         print "# previously, you may want to run it again.\n";
 184     } elsif ($dev < 2.575) {
 185         print "# This is ok, but suspicious. But it will happen\n";
 186         print "# one time out of 25, more or less.\n";
 187         print "# You should run this test again to be sure.\n";
 188     } elsif ($dev < 3.3) {
 189         print "# This is very suspicious. It will happen only\n";
 190         print "# about one time out of 100, more or less.\n";
 191         print "# You should run this test again to be sure.\n";
 192     } elsif ($dev < 3.9) {
 193         print "# This is VERY suspicious. It will happen only\n";
 194         print "# about one time out of 1000, more or less.\n";
 195         print "# You should run this test again to be sure.\n";
 196     } else {
 197         print "# This is VERY VERY suspicious.\n";
 198         print "# Your rand seems to be bogus.\n";
 199     }
 200     print "#\n# If you are having random number troubles,\n";
 201     print "# see the hints within the test script for more\n";
 202     printf "# information on why this might fail. [ %.3f ]\n", $dev;
 203 }
 204
 205
 206 # Now, let's see whether rand accepts its argument
 207 {
 208     my($max, $min);
 209     $max = $min = rand(100);
 210     for (1..$reps) {
 211         my $n = rand(100);
 212         $max = $n if $n > $max;
 213         $min = $n if $n < $min;
 214     }
 215
 216     # This test checks to see that rand(100) really falls
 217     # within the range 0 - 100, and that the numbers produced
 218     # have a reasonably-large range among them.
 219     #
 220     unless ( ok( !($min < 0 or $max >= 100 or ($max - $min) < 65) ) ) {
 221         print "# min too low\n" if $min < 0;
 222         print "# max too high\n" if $max >= 100;
 223         print "# range too narrow\n" if ($max - $min) < 65;
 224     }
 225
 226
 227     # This test checks that rand without an argument
 228     # is equivalent to rand(1).
 229     #
 230     $_ = 12345;         # Just for fun.
 231     srand 12345;
 232     my $r = rand;
 233     srand 12345;
 234     is(rand(1),  $r,  'rand() without args is rand(1)');
 235
 236
 237     # This checks that rand without an argument is not
 238     # rand($_). (In case somebody got overzealous.)
 239     #
 240     ok($r < 1,        'rand() without args is under 1');
 241 }
 242