I've split off the srand() tests into their own test file and added in
some more.
I've discovered a bug/undocumented feature. srand() appears to take
integers, at least on Linux. Perl silently truncates them. It
appears that's because ANSI C's srand takes an unsigned integer.
I've added docs to perlfunc that reflect this.
--- MANIFEST 2001/09/03 10:44:48 1.2
+++ MANIFEST 2001/09/03 10:44:59
@@ -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
--- pod/perlfunc.pod 2001/09/03 11:31:30 1.1
+++ pod/perlfunc.pod 2001/09/03 11:37:23
@@ -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
--- /dev/null Mon Sep 3 07:41:34 2001
+++ /usr/local/src/perl-current/t/op/srand.t Mon Sep 3 07:41:34 2001
@@ -0,0 +1,63 @@
+#!./perl -w
+
+# Test srand.
+
+use strict;
+use Test::More tests => 5;
+
+# Generate a load of random numbers.
+# int() avoids possible floating point error.
+sub mk_rand { map int rand 10000, 1..100; }
+
+
+# Check that rand() is deterministic.
+srand(1138);
+my @first_run = mk_rand;
+
+srand(1138);
+my @second_run = mk_rand;
+
+ok( eq_array(\@first_run, \@second_run), 'srand(), same arg, same rands' );
+
+
+# Check that different seeds provide different random numbers
+srand(31337);
+@first_run = mk_rand;
+
+srand(1138);
+@second_run = mk_rand;
+
+ok( !eq_array(\@first_run, \@second_run),
+ 'srand(), different arg, different rands' );
+
+
+# Check that srand() with no args provides different seeds.
+srand();
+@first_run = mk_rand;
+
+srand();
+@second_run = mk_rand;
+
+ok( !eq_array(\@first_run, \@second_run), 'srand(), no arg, different rands');
+
+
+# Check that srand() isn't effected by $_
+{
+ local $_ = 42;
+ srand();
+ @first_run = mk_rand;
+
+ srand();
+ @second_run = mk_rand;
+
+ ok( !eq_array(\@first_run, \@second_run),
+ 'srand(), no arg, not effected by $_');
+}
+
+
+
+# This test checks whether Perl called srand for you.
+@first_run = `$^X -le "print int rand 100 for 1..100"`;
+@second_run = `$^X -le "print int rand 100 for 1..100"`;
+
+ok( !eq_array(\@first_run, \@second_run), 'srand() called automatically');
--- t/op/rand.t 2001/09/03 11:07:09 1.2
+++ t/op/rand.t 2001/09/03 11:40:38
@@ -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";
-}
--
Michael G. Schwern <[EMAIL PROTECTED]> http://www.pobox.com/~schwern/
Perl6 Quality Assurance <[EMAIL PROTECTED]> Kwalitee Is Job One
Let's enjoy the traditional custom in Peru of getting leprosy.
