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 18BEGIN { 19 chdir "t" if -d "t"; 20 @INC = '../lib'; 21} 22 23use strict; 24use Config; 25 26print "1..11\n"; 27 28srand; # Shouldn't need this with 5.004... 29 # But I'll include it now and test for 30 # whether we needed it later. 31 32my $reps = 1000; # How many times to try rand each time. 33 # May be changed, but should be over 500. 34 # The more the better! (But slower.) 35 36sub bits ($) { 37 # Takes a small integer and returns the number of one-bits in it. 38 my $total; 39 my $bits = sprintf "%o", $_[0]; 40 while (length $bits) { 41 $total += (0,1,1,2,1,2,2,3)[chop $bits]; # Oct to bits 42 } 43 $total; 44} 45 46# First, let's see whether randbits is set right 47{ 48 my($max, $min, $sum); # Characteristics of rand 49 my($off, $shouldbe); # Problems with randbits 50 my($dev, $bits); # Number of one bits 51 my $randbits = $Config{randbits}; 52 $max = $min = rand(1); 53 for (1..$reps) { 54 my $n = rand(1); 55 if ($n < 0.0 or $n >= 1.0) { 56 print <<EOM; 57# WHOA THERE! \$Config{drand01} is set to '$Config{drand01}', 58# but that apparently produces values < 0.0 or >= 1.0. 59# Make sure \$Config{drand01} is a valid expression in the 60# C-language, and produces values in the range [0.0,1.0). 61# 62# I give up. 63EOM 64 exit; 65 } 66 $sum += $n; 67 $bits += bits($n * 256); # Don't be greedy; 8 is enough 68 # It's too many if randbits is less than 8! 69 # But that should never be the case... I hope. 70 # Note: If you change this, you must adapt the 71 # formula for absolute standard deviation, below. 72 $max = $n if $n > $max; 73 $min = $n if $n < $min; 74 } 75 76 77 # Hints for TEST 1 78 # 79 # This test checks for one of Perl's most frequent 80 # mis-configurations. Your system's documentation 81 # for rand(2) should tell you what value you need 82 # for randbits. Usually the diagnostic message 83 # has the right value as well. Just fix it and 84 # recompile, and you'll usually be fine. (The main 85 # reason that the diagnostic message might get the 86 # wrong value is that Config.pm is incorrect.) 87 # 88 if ($max <= 0 or $max >= (2 ** $randbits)) {# Just in case... 89 print "# max=[$max] min=[$min]\nnot ok 1\n"; 90 print "# This perl was compiled with randbits=$randbits\n"; 91 print "# which is _way_ off. Or maybe your system rand is broken,\n"; 92 print "# or your C compiler can't multiply, or maybe Martians\n"; 93 print "# have taken over your computer. For starters, see about\n"; 94 print "# trying a better value for randbits, probably smaller.\n"; 95 # If that isn't the problem, we'll have 96 # to put d_martians into Config.pm 97 print "# Skipping remaining tests until randbits is fixed.\n"; 98 exit; 99 } 100 101 $off = log($max) / log(2); # log2 102 $off = int($off) + ($off > 0); # Next more positive int 103 if ($off) { 104 $shouldbe = $Config{randbits} + $off; 105 print "# max=[$max] min=[$min]\nnot ok 1\n"; 106 print "# This perl was compiled with randbits=$randbits on $^O.\n"; 107 print "# Consider using randbits=$shouldbe instead.\n"; 108 # And skip the remaining tests; they would be pointless now. 109 print "# Skipping remaining tests until randbits is fixed.\n"; 110 exit; 111 } else { 112 print "ok 1\n"; 113 } 114 115 # Hints for TEST 2 116 # 117 # This should always be true: 0 <= rand(1) < 1 118 # If this test is failing, something is seriously wrong, 119 # either in perl or your system's rand function. 120 # 121 if ($min < 0 or $max >= 1) { # Slightly redundant... 122 print "not ok 2\n"; 123 print "# min too low\n" if $min < 0; 124 print "# max too high\n" if $max >= 1; 125 } else { 126 print "ok 2\n"; 127 } 128 129 # Hints for TEST 3 130 # 131 # This is just a crude test. The average number produced 132 # by rand should be about one-half. But once in a while 133 # it will be relatively far away. Note: This test will 134 # occasionally fail on a perfectly good system! 135 # See the hints for test 4 to see why. 136 # 137 $sum /= $reps; 138 if ($sum < 0.4 or $sum > 0.6) { 139 print "not ok 3\n# Average random number is far from 0.5\n"; 140 } else { 141 print "ok 3\n"; 142 } 143 144 # Hints for TEST 4 145 # 146 # NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE 147 # This test will fail .1% of the time on a normal system. 148 # also 149 # This test asks you to see these hints 100% of the time! 150 # NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE 151 # 152 # There is probably no reason to be alarmed that 153 # something is wrong with your rand function. But, 154 # if you're curious or if you can't help being 155 # alarmed, keep reading. 156 # 157 # This is a less-crude test than test 3. But it has 158 # the same basic flaw: Unusually distributed random 159 # values should occasionally appear in every good 160 # random number sequence. (If you flip a fair coin 161 # twenty times every day, you'll see it land all 162 # heads about one time in a million days, on the 163 # average. That might alarm you if you saw it happen 164 # on the first day!) 165 # 166 # So, if this test failed on you once, run it a dozen 167 # times. If it keeps failing, it's likely that your 168 # rand is bogus. If it keeps passing, it's likely 169 # that the one failure was bogus. If it's a mix, 170 # read on to see about how to interpret the tests. 171 # 172 # The number printed in square brackets is the 173 # standard deviation, a statistical measure 174 # of how unusual rand's behavior seemed. It should 175 # fall in these ranges with these *approximate* 176 # probabilities: 177 # 178 # under 1 68.26% of the time 179 # 1-2 27.18% of the time 180 # 2-3 4.30% of the time 181 # over 3 0.26% of the time 182 # 183 # If the numbers you see are not scattered approximately 184 # (not exactly!) like that table, check with your vendor 185 # to find out what's wrong with your rand. Or with this 186 # algorithm. :-) 187 # 188 # Calculating absoulute standard deviation for number of bits set 189 # (eight bits per rep) 190 $dev = abs ($bits - $reps * 4) / sqrt($reps * 2); 191 192 if ($dev < 1.96) { 193 print "ok 4\n"; # 95% of the time. 194 print "# Your rand seems fine. If this test failed\n"; 195 print "# previously, you may want to run it again.\n"; 196 } elsif ($dev < 2.575) { 197 print "ok 4\n# In here about 4% of the time. Hmmm...\n"; 198 print "# This is ok, but suspicious. But it will happen\n"; 199 print "# one time out of 25, more or less.\n"; 200 print "# You should run this test again to be sure.\n"; 201 } elsif ($dev < 3.3) { 202 print "ok 4\n# In this range about 1% of the time.\n"; 203 print "# This is very suspicious. It will happen only\n"; 204 print "# about one time out of 100, more or less.\n"; 205 print "# You should run this test again to be sure.\n"; 206 } elsif ($dev < 3.9) { 207 print "not ok 4\n# In this range very rarely.\n"; 208 print "# This is VERY suspicious. It will happen only\n"; 209 print "# about one time out of 1000, more or less.\n"; 210 print "# You should run this test again to be sure.\n"; 211 } else { 212 print "not ok 4\n# Seriously whacked.\n"; 213 print "# This is VERY VERY suspicious.\n"; 214 print "# Your rand seems to be bogus.\n"; 215 } 216 print "#\n# If you are having random number troubles,\n"; 217 print "# see the hints within the test script for more\n"; 218 printf "# information on why this might fail. [ %.3f ]\n", $dev; 219} 220 221{ 222 srand; # These three lines are for test 7 223 my $time = time; # It's just faster to do them here. 224 my $rand = join ", ", rand, rand, rand; 225 226 # Hints for TEST 5 227 # 228 # This test checks that the argument to srand actually 229 # sets the seed for generating random numbers. 230 # 231 srand(3.14159); 232 my $r = rand; 233 srand(3.14159); 234 if (rand != $r) { 235 print "not ok 5\n"; 236 print "# srand is not consistent.\n"; 237 } else { 238 print "ok 5\n"; 239 } 240 241 # Hints for TEST 6 242 # 243 # This test just checks that the previous one didn't 244 # give us false confidence! 245 # 246 if (rand == $r) { 247 print "not ok 6\n"; 248 print "# rand is now unchanging!\n"; 249 } else { 250 print "ok 6\n"; 251 } 252 253 # Hints for TEST 7 254 # 255 # This checks that srand without arguments gives 256 # different sequences each time. Note: You shouldn't 257 # be calling srand more than once unless you know 258 # what you're doing! But if this fails on your 259 # system, run perlbug and let the developers know 260 # what other sources of randomness srand should 261 # tap into. 262 # 263 while ($time == time) { } # Wait for new second, just in case. 264 srand; 265 if ((join ", ", rand, rand, rand) eq $rand) { 266 print "not ok 7\n"; 267 print "# srand without args isn't varying.\n"; 268 } else { 269 print "ok 7\n"; 270 } 271} 272 273# Now, let's see whether rand accepts its argument 274{ 275 my($max, $min); 276 $max = $min = rand(100); 277 for (1..$reps) { 278 my $n = rand(100); 279 $max = $n if $n > $max; 280 $min = $n if $n < $min; 281 } 282 283 # Hints for TEST 8 284 # 285 # This test checks to see that rand(100) really falls 286 # within the range 0 - 100, and that the numbers produced 287 # have a reasonably-large range among them. 288 # 289 if ($min < 0 or $max >= 100 or ($max - $min) < 65) { 290 print "not ok 8\n"; 291 print "# min too low\n" if $min < 0; 292 print "# max too high\n" if $max >= 100; 293 print "# range too narrow\n" if ($max - $min) < 65; 294 } else { 295 print "ok 8\n"; 296 } 297 298 # Hints for TEST 9 299 # 300 # This test checks that rand without an argument 301 # is equivalent to rand(1). 302 # 303 $_ = 12345; # Just for fun. 304 srand 12345; 305 my $r = rand; 306 srand 12345; 307 if (rand(1) == $r) { 308 print "ok 9\n"; 309 } else { 310 print "not ok 9\n"; 311 print "# rand without arguments isn't rand(1)!\n"; 312 } 313 314 # Hints for TEST 10 315 # 316 # This checks that rand without an argument is not 317 # rand($_). (In case somebody got overzealous.) 318 # 319 if ($r >= 1) { 320 print "not ok 10\n"; 321 print "# rand without arguments isn't under 1!\n"; 322 } else { 323 print "ok 10\n"; 324 } 325} 326 327# Hints for TEST 11 328# 329# This test checks whether Perl called srand for you. This should 330# be the case in version 5.004 and later. Note: You must still 331# call srand if your code might ever be run on a pre-5.004 system! 332# 333AUTOSRAND: 334{ 335 unless ($Config{d_fork}) { 336 # Skip this test. It's not likely to be system-specific, anyway. 337 print "ok 11\n# Skipping this test on this platform.\n"; 338 last; 339 } 340 341 my($pid, $first); 342 for (1..5) { 343 my $PERL = (($^O eq 'VMS') ? "MCR $^X" 344 : ($^O eq 'MSWin32') ? '.\perl' 345 : './perl'); 346 $pid = open PERL, qq[$PERL -e "print rand"|]; 347 die "Couldn't pipe from perl: $!" unless defined $pid; 348 if (defined $first) { 349 if ($first ne <PERL>) { 350 print "ok 11\n"; 351 last AUTOSRAND; 352 } 353 } else { 354 $first = <PERL>; 355 } 356 close PERL or die "perl returned error code $?"; 357 } 358 print "not ok 11\n# srand isn't being autocalled.\n"; 359} 360