home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / op / rand.t < prev    next >
Text File  |  1999-07-20  |  11KB  |  360 lines
  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.     unshift @INC, "../lib" if -d "../lib";
  21. }
  22.  
  23. use strict;
  24. use Config;
  25.  
  26. print "1..11\n";
  27.  
  28. srand;            # Shouldn't need this with 5.004...
  29.             # But I'll include it now and test for
  30.             # whether we needed it later.
  31.  
  32. my $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.  
  36. sub 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.
  63. EOM
  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. #
  333. AUTOSRAND:
  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.