From: Michael G. Schwern <schwern@pobox.com>
Date: Mon, 3 Sep 2001 07:43:00 +0000 (-0400)
Subject: Tests for srand()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9be67dbc13b2c63ded42048245f871f99aa3fa6c;p=p5sagit%2Fp5-mst-13.2.git

Tests for srand()
Message-ID: <20010903074300.E9233@blackrider>

p4raw-id: //depot/perl@11840
---

diff --git a/MANIFEST b/MANIFEST
index 65b1751..a4f2b75 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2083,6 +2083,7 @@ t/op/sort.t			See if sort works
 t/op/splice.t			See if splice works
 t/op/split.t			See if split works
 t/op/sprintf.t			See if sprintf works
+t/op/srand.t                    See if srand works
 t/op/stat.t			See if stat works
 t/op/study.t			See if study works
 t/op/subst.t			See if substitution works
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 68ca8d7..78a0cb2 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -4786,6 +4786,11 @@ seed was just the current C<time>.  This isn't a particularly good seed,
 so many old programs supply their own seed value (often C<time ^ $$> or
 C<time ^ ($$ + ($$ << 15))>), but that isn't necessary any more.
 
+Most implementations of C<srand> take an integer and will silently
+truncate decimal numbers.  This means C<srand(42)> will usually
+produce the same results as C<srand(42.1)>.  To be safe, always pass
+C<srand> an integer.
+
 In fact, it's usually not necessary to call C<srand> at all, because if
 it is not called explicitly, it is called implicitly at the first use of
 the C<rand> operator.  However, this was not the case in version of Perl
diff --git a/t/op/rand.t b/t/op/rand.t
index aa2421b..44bf0ff 100755
--- a/t/op/rand.t
+++ b/t/op/rand.t
@@ -22,8 +22,8 @@ BEGIN {
 
 use strict;
 use Config;
+use Test::More tests => 8;
 
-print "1..11\n";
 
 my $reps = 10000;	# How many times to try rand each time.
 			# May be changed, but should be over 500.
@@ -70,8 +70,6 @@ EOM
     }
 
 
-    # Hints for TEST 1
-    #
     # This test checks for one of Perl's most frequent
     # mis-configurations. Your system's documentation
     # for rand(2) should tell you what value you need
@@ -81,13 +79,16 @@ EOM
     # reason that the diagnostic message might get the
     # wrong value is that Config.pm is incorrect.)
     #
-    if ($max <= 0 or $max >= (2 ** $randbits)) {# Just in case...
-	print "# max=[$max] min=[$min]\nnot ok 1\n";
-	print "# This perl was compiled with randbits=$randbits\n";
-	print "# which is _way_ off. Or maybe your system rand is broken,\n";
-	print "# or your C compiler can't multiply, or maybe Martians\n";
-	print "# have taken over your computer. For starters, see about\n";
-	print "# trying a better value for randbits, probably smaller.\n";
+    unless (ok( !$max <= 0 or $max >= (2 ** $randbits))) {# Just in case...
+	print <<DIAG;
+# max=[$max] min=[$min]
+# This perl was compiled with randbits=$randbits
+# which is _way_ off. Or maybe your system rand is broken,
+# or your C compiler can't multiply, or maybe Martians
+# have taken over your computer. For starters, see about
+# trying a better value for randbits, probably smaller.
+DIAG
+
 	# If that isn't the problem, we'll have
 	# to put d_martians into Config.pm 
 	print "# Skipping remaining tests until randbits is fixed.\n";
@@ -96,34 +97,27 @@ EOM
 
     $off = log($max) / log(2);			# log2
     $off = int($off) + ($off > 0);		# Next more positive int
-    if ($off) {
+    unless (is( $off, 0 )) {
 	$shouldbe = $Config{randbits} + $off;
-	print "# max=[$max] min=[$min]\nnot ok 1\n";
+	print "# max=[$max] min=[$min]\n";
 	print "# This perl was compiled with randbits=$randbits on $^O.\n";
 	print "# Consider using randbits=$shouldbe instead.\n";
 	# And skip the remaining tests; they would be pointless now.
 	print "# Skipping remaining tests until randbits is fixed.\n";
 	exit;
-    } else {
-	print "ok 1\n";
     }
 
-    # Hints for TEST 2
-    #
+
     # This should always be true: 0 <= rand(1) < 1
     # If this test is failing, something is seriously wrong,
     # either in perl or your system's rand function.
     #
-    if ($min < 0 or $max >= 1) {	# Slightly redundant...
-	print "not ok 2\n";
+    unless (ok( !($min < 0 or $max >= 1) )) {	# Slightly redundant...
 	print "# min too low\n" if $min < 0;
 	print "# max too high\n" if $max >= 1;
-    } else {
-	print "ok 2\n";
     }
 
-    # Hints for TEST 3
-    #
+
     # This is just a crude test. The average number produced
     # by rand should be about one-half. But once in a while
     # it will be relatively far away. Note: This test will
@@ -131,14 +125,11 @@ EOM
     # See the hints for test 4 to see why.
     #
     $sum /= $reps;
-    if ($sum < 0.4 or $sum > 0.6) {
-	print "not ok 3\n# Average random number is far from 0.5\n";
-    } else {
-	print "ok 3\n";
+    unless (ok( !($sum < 0.4 or $sum > 0.6) )) {
+	print "# Average random number is far from 0.5\n";
     }
 
-    # Hints for TEST 4
-    #
+
     #   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
     # This test will fail .1% of the time on a normal system.
     #				also
@@ -185,27 +176,24 @@ EOM
     # (eight bits per rep)
     $dev = abs ($bits - $reps * 4) / sqrt($reps * 2);
 
+    ok( $dev < 3.3 );
+
     if ($dev < 1.96) {
-	print "ok 4\n";		# 95% of the time.
 	print "# Your rand seems fine. If this test failed\n";
 	print "# previously, you may want to run it again.\n";
     } elsif ($dev < 2.575) {
-	print "ok 4\n# In here about 4% of the time. Hmmm...\n";
 	print "# This is ok, but suspicious. But it will happen\n";
 	print "# one time out of 25, more or less.\n";
 	print "# You should run this test again to be sure.\n";
     } elsif ($dev < 3.3) {
-	print "ok 4\n# In this range about 1% of the time.\n";
 	print "# This is very suspicious. It will happen only\n";
 	print "# about one time out of 100, more or less.\n";
 	print "# You should run this test again to be sure.\n";
     } elsif ($dev < 3.9) {
-	print "not ok 4\n# In this range very rarely.\n";
 	print "# This is VERY suspicious. It will happen only\n";
 	print "# about one time out of 1000, more or less.\n";
 	print "# You should run this test again to be sure.\n";
     } else {
-	print "not ok 4\n# Seriously whacked.\n";
 	print "# This is VERY VERY suspicious.\n";
 	print "# Your rand seems to be bogus.\n";
     }
@@ -214,57 +202,6 @@ EOM
     printf "# information on why this might fail. [ %.3f ]\n", $dev;
 }
 
-{
-    srand;		# These three lines are for test 7
-    my $time = time;	# It's just faster to do them here.
-    my $rand = join ", ", rand, rand, rand;
-
-    # Hints for TEST 5
-    # 
-    # This test checks that the argument to srand actually 
-    # sets the seed for generating random numbers. 
-    #
-    srand(3.14159);
-    my $r = rand;
-    srand(3.14159);
-    if (rand != $r) {
-	print "not ok 5\n";
-	print "# srand is not consistent.\n";
-    } else {
-	print "ok 5\n";
-    }
-
-    # Hints for TEST 6
-    # 
-    # This test just checks that the previous one didn't 
-    # give us false confidence!
-    #
-    if (rand == $r) {
-	print "not ok 6\n";
-	print "# rand is now unchanging!\n";
-    } else {
-	print "ok 6\n";
-    }
-
-    # Hints for TEST 7
-    #
-    # This checks that srand without arguments gives
-    # different sequences each time. Note: You shouldn't
-    # be calling srand more than once unless you know
-    # what you're doing! But if this fails on your 
-    # system, run perlbug and let the developers know
-    # what other sources of randomness srand should
-    # tap into.
-    #
-    while ($time == time) { }	# Wait for new second, just in case.
-    srand;
-    if ((join ", ", rand, rand, rand) eq $rand) {
-	print "not ok 7\n";
-	print "# srand without args isn't varying.\n";
-    } else {
-	print "ok 7\n";
-    }
-}
 
 # Now, let's see whether rand accepts its argument
 {
@@ -276,23 +213,17 @@ EOM
 	$min = $n if $n < $min;
     }
 
-    # Hints for TEST 8
-    #
     # This test checks to see that rand(100) really falls 
     # within the range 0 - 100, and that the numbers produced
     # have a reasonably-large range among them.
     #
-    if ($min < 0 or $max >= 100 or ($max - $min) < 65) {
-	print "not ok 8\n";
+    unless ( ok( !($min < 0 or $max >= 100 or ($max - $min) < 65) ) ) {
 	print "# min too low\n" if $min < 0;
 	print "# max too high\n" if $max >= 100;
 	print "# range too narrow\n" if ($max - $min) < 65;
-    } else {
-	print "ok 8\n";
     }
 
-    # Hints for TEST 9
-    #
+
     # This test checks that rand without an argument
     # is equivalent to rand(1).
     #
@@ -300,57 +231,12 @@ EOM
     srand 12345;
     my $r = rand;
     srand 12345;
-    if (rand(1) == $r) {
-	print "ok 9\n";
-    } else {
-	print "not ok 9\n";
-	print "# rand without arguments isn't rand(1)!\n";
-    }
+    is(rand(1),  $r,  'rand() without args is rand(1)');
+
 
-    # Hints for TEST 10
-    #
     # This checks that rand without an argument is not
     # rand($_). (In case somebody got overzealous.)
     # 
-    if ($r >= 1) {
-	print "not ok 10\n";
-	print "# rand without arguments isn't under 1!\n";
-    } else {
-	print "ok 10\n";
-    }
+    ok($r < 1,        'rand() without args is under 1');
 }
 
-# Hints for TEST 11
-#
-# This test checks whether Perl called srand for you. This should
-# be the case in version 5.004 and later. Note: You must still
-# call srand if your code might ever be run on a pre-5.004 system!
-#
-AUTOSRAND:
-{
-    unless ($Config{d_fork}) {
-	# Skip this test. It's not likely to be system-specific, anyway.
-	print "ok 11\n# Skipping this test on this platform.\n";
-	last;
-    }
-
-    my($pid, $first);
-    for (1..5) {
-	my $PERL = (($^O eq 'VMS') ? "MCR $^X"
-		    : ($^O eq 'MSWin32') ? '.\perl'
-		    : ($^O eq 'NetWare') ? 'perl'
-		    : './perl');
-	$pid = open PERL, qq[$PERL -e "print rand"|];
-	die "Couldn't pipe from perl: $!" unless defined $pid;
-	if (defined $first) {
-	    if ($first ne <PERL>) {
-		print "ok 11\n";
-		last AUTOSRAND;
-	    }
-	} else {
-	    $first = <PERL>;
-	}
-	close PERL or die "perl returned error code $?";
-    }
-    print "not ok 11\n# srand isn't being autocalled.\n";
-}