Change 11840 by sky@sky-lab on 2001/09/03 11:02:04
Subject: [PATCH t/op/srand.t t/op/rand.t pod/perlfunc.pod MANIFEST] Tests for
srand()
From: Michael G Schwern <[EMAIL PROTECTED]>
Date: Mon, 3 Sep 2001 07:43:00 -0400
Message-ID: <20010903074300.E9233@blackrider>
Affected files ...
... //depot/perl/MANIFEST#531 edit
... //depot/perl/pod/perlfunc.pod#256 edit
... //depot/perl/t/op/rand.t#13 edit
Differences ...
==== //depot/perl/MANIFEST#531 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Mon Sep 3 05:15:05 2001
+++ perl/MANIFEST Mon Sep 3 05:15:05 2001
@@ -2083,6 +2083,7 @@
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
==== //depot/perl/pod/perlfunc.pod#256 (text) ====
Index: perl/pod/perlfunc.pod
--- perl/pod/perlfunc.pod.~1~ Mon Sep 3 05:15:05 2001
+++ perl/pod/perlfunc.pod Mon Sep 3 05:15:05 2001
@@ -4786,6 +4786,11 @@
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
==== //depot/perl/t/op/rand.t#13 (xtext) ====
Index: perl/t/op/rand.t
--- perl/t/op/rand.t.~1~ Mon Sep 3 05:15:05 2001
+++ perl/t/op/rand.t Mon Sep 3 05:15:05 2001
@@ -22,8 +22,8 @@
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 @@
}
- # 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 @@
# 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 @@
$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 @@
# 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 @@
# (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 @@
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 @@
$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 @@
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";
-}
End of Patch.
