In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/6c2a892eeccd45d5cba4b4150f993b2f177c3e6a?hp=9a7064eebb5f783e25d58308ab45972ebb3c1a7c>
- Log ----------------------------------------------------------------- commit 6c2a892eeccd45d5cba4b4150f993b2f177c3e6a Author: Nicholas Clark <[email protected]> Date: Tue Dec 14 16:59:11 2010 +0000 Convert ext/Fcntl/t/syslfs.t to Test::More and t/op/lfs.t to test.pl M ext/Fcntl/t/syslfs.t M t/op/lfs.t commit 02455492c4700a29a5d3066a182496a7efc547f3 Author: Nicholas Clark <[email protected]> Date: Tue Dec 14 16:58:10 2010 +0000 Add $Tests_Are_Passing to test.pl, analogous to Test::Builder's is_passing(). M t/test.pl commit 90a99f495949b5c02a82b563bc1b72671aefd96c Author: Nicholas Clark <[email protected]> Date: Tue Dec 14 16:12:39 2010 +0000 In Fcntl's syslfs.t and t/op/lfs.t, eliminate bye(). Its cleanup actions are implicit in the END block, so replace C<warn ...; bye>; with C<die ...> and other calls of C<bye;> with C<exit 0;> Also, remove the newlines from the strings passed to die, to make the diagnostics more useful for locating failures. M ext/Fcntl/t/syslfs.t M t/op/lfs.t commit 09eb7cfbca20b4071e1b90c66713173d118d1d47 Author: Nicholas Clark <[email protected]> Date: Tue Dec 14 15:43:02 2010 +0000 In Fcntl's syslfs.t and t/op/lfs.t, eliminate zap(). Now that we're using tempfiles, it no longer contains code to unlink the test files, only a close. Inline the C<close BIG> into bye(), and remove the other call to zap(), which was immediately after an explicit close of BIG. M ext/Fcntl/t/syslfs.t M t/op/lfs.t commit 80ed94815e0438a29d0ed646ff1c528d910e8a2d Author: Nicholas Clark <[email protected]> Date: Mon Dec 13 17:20:44 2010 +0000 Refactor syslfs.t and lfs.t to call bye() directly from explain() when skipping. This will make it easier to refactoring to use Test::More/test.pl M ext/Fcntl/t/syslfs.t M t/op/lfs.t commit 3d336648fb8d0ef0e9f30c671a256cbab6ba5d5a Author: Nicholas Clark <[email protected]> Date: Mon Dec 13 17:01:09 2010 +0000 Convert ext/Fcntl/t/syslfs.t to File::Temp This reduces the differences between ext/Fcntl/t/syslfs.t and t/op/lfs.t M ext/Fcntl/t/syslfs.t commit 6c1d9365d5a8554499913c23b54871cf8767dc2a Author: Nicholas Clark <[email protected]> Date: Mon Dec 13 14:42:32 2010 +0000 Reduce inconsistencies between ext/Fcntl/t/syslfs.t and t/op/lfs.t The two are testing the same functionality, and comments in each reference the other. However, the two have diverged, sometimes in the same commit, sometimes when corrections have been applied to only one. (eg 972720f939262dd0) M ext/Fcntl/t/syslfs.t M t/op/lfs.t commit 96dca4d4be66035dc9293a9939950c0986912977 Author: Nicholas Clark <[email protected]> Date: Mon Dec 13 16:08:38 2010 +0000 Check return values in the test programs run by syslfs.t and lfs.t Also fix a bug introduced in 1c25d394345c1b97, which accidentally neutered the test program of t/op/lfs.t, causing it to attempt to open an empty file, and hence do nothing and then always exit with 0. M ext/Fcntl/t/syslfs.t M t/op/lfs.t ----------------------------------------------------------------------- Summary of changes: ext/Fcntl/t/syslfs.t | 145 +++++++++++++++++++------------------------------- t/op/lfs.t | 136 +++++++++++++++++------------------------------ t/test.pl | 8 +++- 3 files changed, 111 insertions(+), 178 deletions(-) diff --git a/ext/Fcntl/t/syslfs.t b/ext/Fcntl/t/syslfs.t index f0f1881..09dea10 100644 --- a/ext/Fcntl/t/syslfs.t +++ b/ext/Fcntl/t/syslfs.t @@ -13,23 +13,14 @@ BEGIN { } use strict; - -$| = 1; +use File::Temp 'tempfile'; +use Test::More; our @s; -our $fail; - -sub zap { - close(BIG); - unlink("big"); - unlink("big1"); - unlink("big2"); -} -sub bye { - zap(); - exit(0); -} +(undef, my $big0) = tempfile(UNLINK => 1); +(undef, my $big1) = tempfile(UNLINK => 1); +(undef, my $big2) = tempfile(UNLINK => 1); my $explained; @@ -52,22 +43,24 @@ sub explain { # EOM } - print "1..0 # Skip: @_\n" if @_; + if (@_) { + plan(skip_all => "@_"); + } } +$| = 1; + print "# checking whether we have sparse files...\n"; # Known have-nots. if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') { - print "1..0 # Skip: no sparse files in $^O\n"; - bye(); + plan(skip_all => "no sparse files in $^O"); } # Known haves that have problems running this test # (for example because they do not support sparse files, like UNICOS) if ($^O eq 'unicos') { - print "1..0 # Skip: no sparse files in $^0, unable to test large files\n"; - bye(); + plan(skip_all => "no sparse files in $^O, unable to test large files"); } # Then try heuristically to deduce whether we have sparse files. @@ -77,39 +70,36 @@ if ($^O eq 'unicos') { # consume less blocks than one megabyte (assuming nobody has # one megabyte blocks...) -sysopen(BIG, "big1", O_WRONLY|O_CREAT|O_TRUNC) or - do { warn "sysopen big1 failed: $!\n"; bye }; +sysopen(BIG, $big1, O_WRONLY|O_CREAT|O_TRUNC) or + die "sysopen $big1 failed: $!"; sysseek(BIG, 1_000_000, SEEK_SET) or - do { warn "sysseek big1 failed: $!\n"; bye }; + die "sysseek $big1 failed: $!"; syswrite(BIG, "big") or - do { warn "syswrite big1 failed; $!\n"; bye }; + die "syswrite $big1 failed: $!"; close(BIG) or - do { warn "close big1 failed: $!\n"; bye }; + die "close $big1 failed: $!"; -my @s1 = stat("big1"); +my @s1 = stat($big1); print "# s1 = @s1\n"; -sysopen(BIG, "big2", O_WRONLY|O_CREAT|O_TRUNC) or - do { warn "sysopen big2 failed: $!\n"; bye }; +sysopen(BIG, $big2, O_WRONLY|O_CREAT|O_TRUNC) or + die "sysopen $big2 failed: $!"; sysseek(BIG, 2_000_000, SEEK_SET) or - do { warn "sysseek big2 failed: $!\n"; bye }; + die "sysseek $big2 failed: $!"; syswrite(BIG, "big") or - do { warn "syswrite big2 failed; $!\n"; bye }; + die "syswrite $big2 failed: $!"; close(BIG) or - do { warn "close big2 failed: $!\n"; bye }; + die "close $big2 failed: $!"; -my @s2 = stat("big2"); +my @s2 = stat($big2); print "# s2 = @s2\n"; -zap(); - unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 && $s1[11] == $s2[11] && $s1[12] == $s2[12] && $s1[12] > 0) { - print "1..0 # Skip: no sparse files?\n"; - bye; + plan(skip_all => "no sparse files?"); } print "# we seem to have sparse files...\n"; @@ -122,26 +112,26 @@ $ENV{LC_ALL} = "C"; my $perl = '../../perl'; unless (-x $perl) { - print "1..1\nnot ok 1 - can't find perl: expected $perl\n"; - exit 0; + plan(tests => 1); + fail("can't find perl: expected $perl"); } -my $r = system $perl, '-I../lib', '-e', <<'EOF'; +my $r = system $perl, '-I../lib', '-e', <<"EOF"; use Fcntl qw(/^O_/ /^SEEK_/); -sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or die $!; -my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET); -my $syswrite = syswrite(BIG, "big"); +sysopen \$big, q{$big0}, O_WRONLY|O_CREAT|O_TRUNC or die qq{sysopen $big0 $!}; +sysseek \$big, 5_000_000_000, SEEK_SET or die qq{sysseek $big0 $!}; +syswrite \$big, "big" or die qq{syswrite $big0 $!}; +close \$big or die qq{close $big0: $!}; exit 0; EOF -sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or - do { warn "sysopen 'big' failed: $!\n"; bye }; +sysopen(BIG, $big0, O_WRONLY|O_CREAT|O_TRUNC) or + die "sysopen $big0 failed: $!"; my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET); unless (! $r && defined $sysseek && $sysseek == 5_000_000_000) { $sysseek = 'undef' unless defined $sysseek; explain("seeking past 2GB failed: ", $r ? 'signal '.($r & 0x7f) : "$! (sysseek returned $sysseek)"); - bye(); } # The syswrite will fail if there are are filesize limitations (process or fs). @@ -159,24 +149,18 @@ unless($syswrite && $close) { } else { explain("error: $!"); } - bye(); } -...@s = stat("big"); +...@s = stat($big0); print "# @s\n"; unless ($s[7] == 5_000_000_003) { explain("kernel/fs not configured to use large files?"); - bye(); -} - -sub fail () { - print "not "; - $fail++; } sub offset ($$) { + local $Test::Builder::Level = $Test::Builder::Level + 1; my ($offset_will_be, $offset_want) = @_; my $offset_is = eval $offset_will_be; unless ($offset_is == $offset_want) { @@ -193,84 +177,65 @@ sub offset ($$) { $offset_want, $offset_is; } - fail; + fail($offset_will_be); + } else { + pass($offset_will_be); } } -print "1..17\n"; +plan(tests => 17); -$fail = 0; +is($s[7], 5_000_000_003, 'exercises pp_stat'); +is(-s $big0, 5_000_000_003, 'exercises pp_ftsize'); -fail unless $s[7] == 5_000_000_003; # exercizes pp_stat -print "ok 1\n"; +is(-e $big0, 1); +is(-f $big0, 1); -fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize -print "ok 2\n"; - -fail unless -e "big"; -print "ok 3\n"; - -fail unless -f "big"; -print "ok 4\n"; - -sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye }; +sysopen(BIG, $big0, O_RDONLY) or die "sysopen failed: $!"; offset('sysseek(BIG, 4_500_000_000, SEEK_SET)', 4_500_000_000); -print "ok 5\n"; offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_000); -print "ok 6\n"; +# If you get 205_032_705 from here it means that +# your tell() is returning 32-bit values since (I32)4_500_000_001 +# is exactly 205_032_705. offset('sysseek(BIG, 1, SEEK_CUR)', 4_500_000_001); -print "ok 7\n"; offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_001); -print "ok 8\n"; offset('sysseek(BIG, -1, SEEK_CUR)', 4_500_000_000); -print "ok 9\n"; offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_000); -print "ok 10\n"; offset('sysseek(BIG, -3, SEEK_END)', 5_000_000_000); -print "ok 11\n"; offset('sysseek(BIG, 0, SEEK_CUR)', 5_000_000_000); -print "ok 12\n"; my $big; -fail unless sysread(BIG, $big, 3) == 3; -print "ok 13\n"; +is(sysread(BIG, $big, 3), 3); -fail unless $big eq "big"; -print "ok 14\n"; +is($big, "big"); # 705_032_704 = (I32)5_000_000_000 # See that we don't have "big" in the 705_... spot: # that would mean that we have a wraparound. -fail unless sysseek(BIG, 705_032_704, SEEK_SET); -print "ok 15\n"; +isnt(sysseek(BIG, 705_032_704, SEEK_SET), undef); my $zero; -fail unless read(BIG, $zero, 3) == 3; -print "ok 16\n"; - -fail unless $zero eq "\0\0\0"; -print "ok 17\n"; +is(read(BIG, $zero, 3), 3); -explain() if $fail; +is($zero, "\0\0\0"); -bye(); # does the necessary cleanup +explain() unless Test::Builder->new()->is_passing(); END { # unlink may fail if applied directly to a large file # be paranoid about leaving 5 gig files lying around - open(BIG, ">big"); # truncate + open(BIG, ">$big0"); # truncate close(BIG); - 1 while unlink "big"; # standard portable idiom } # eof diff --git a/t/op/lfs.t b/t/op/lfs.t index df9323f..ad913b6 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -17,21 +17,11 @@ BEGIN { use strict; our @s; -our $fail; my $big0 = tempfile(); my $big1 = tempfile(); my $big2 = tempfile(); -sub zap { - close(BIG); -} - -sub bye { - zap(); - exit(0); -} - my $explained; sub explain { @@ -53,7 +43,9 @@ sub explain { # EOM } - print "1..0 # Skip: @_\n" if @_; + if (@_) { + plan(skip_all => "@_"); + } } $| = 1; @@ -62,22 +54,22 @@ print "# checking whether we have sparse files...\n"; # Known have-nots. if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') { - print "1..0 # Skip: no sparse files in $^O\n"; - bye(); + plan(skip_all => "no sparse files in $^O"); } # Known haves that have problems running this test # (for example because they do not support sparse files, like UNICOS) if ($^O eq 'unicos') { - print "1..0 # Skip: no sparse files in $^O, unable to test large files\n"; - bye(); + plan(skip_all => "no sparse files in $^O, unable to test large files"); } -# Then try to heuristically deduce whether we have sparse files. +# Then try heuristically to deduce whether we have sparse files. # Let's not depend on Fcntl or any other extension. -my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2); +sub SEEK_SET () {0} +sub SEEK_CUR () {1} +sub SEEK_END () {2} # We'll start off by creating a one megabyte file which has # only three "true" bytes. If we have sparseness, we should @@ -85,42 +77,39 @@ my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2); # one megabyte blocks...) open(BIG, ">$big1") or - do { warn "open $big1 failed: $!\n"; bye }; + die "open $big1 failed: $!"; binmode(BIG) or - do { warn "binmode $big1 failed: $!\n"; bye }; -seek(BIG, 1_000_000, $SEEK_SET) or - do { warn "seek $big1 failed: $!\n"; bye }; + die "binmode $big1 failed: $!"; +seek(BIG, 1_000_000, SEEK_SET) or + die "seek $big1 failed: $!"; print BIG "big" or - do { warn "print $big1 failed: $!\n"; bye }; + die "print $big1 failed: $!"; close(BIG) or - do { warn "close $big1 failed: $!\n"; bye }; + die "close $big1 failed: $!"; my @s1 = stat($big1); print "# s1 = @s1\n"; open(BIG, ">$big2") or - do { warn "open $big2 failed: $!\n"; bye }; + die "open $big2 failed: $!"; binmode(BIG) or - do { warn "binmode $big2 failed: $!\n"; bye }; -seek(BIG, 2_000_000, $SEEK_SET) or - do { warn "seek $big2 failed; $!\n"; bye }; + die "binmode $big2 failed: $!"; +seek(BIG, 2_000_000, SEEK_SET) or + die "seek $big2 failed: $!"; print BIG "big" or - do { warn "print $big2 failed; $!\n"; bye }; + die "print $big2 failed: $!"; close(BIG) or - do { warn "close $big2 failed; $!\n"; bye }; + die "close $big2 failed: $!"; my @s2 = stat($big2); print "# s2 = @s2\n"; -zap(); - unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 && $s1[11] == $s2[11] && $s1[12] == $s2[12] && $s1[12] > 0) { - print "1..0 # Skip: no sparse files?\n"; - bye; + plan(skip_all => "no sparse files?"); } print "# we seem to have sparse files...\n"; @@ -131,19 +120,19 @@ print "# we seem to have sparse files...\n"; $ENV{LC_ALL} = "C"; -my $r = system '../perl', '-e', <<'EOF'; -open(BIG, ">$big0"); -seek(BIG, 5_000_000_000, 0); -print BIG $big0; +my $r = system '../perl', '-e', <<"EOF"; +open my \$big, '>', q{$big0} or die qq{open $big0: $!}; +seek \$big, 5_000_000_000, 0 or die qq{seek $big0: $!}; +print \$big "big" or die qq{print $big0: $!}; +close \$big or die qq{close $big0: $!}; exit 0; EOF -open(BIG, ">$big0") or do { warn "open failed: $!\n"; bye }; +open(BIG, ">$big0") or die "open failed: $!"; binmode BIG; -if ($r or not seek(BIG, 5_000_000_000, $SEEK_SET)) { +if ($r or not seek(BIG, 5_000_000_000, SEEK_SET)) { my $err = $r ? 'signal '.($r & 0x7f) : $!; explain("seeking past 2GB failed: $err"); - bye(); } # Either the print or (more likely, thanks to buffering) the close will @@ -160,7 +149,6 @@ unless ($print && $close) { } else { explain("error: $!"); } - bye(); } @s = stat($big0); @@ -169,15 +157,10 @@ print "# @s\n"; unless ($s[7] == 5_000_000_003) { explain("kernel/fs not configured to use large files?"); - bye(); -} - -sub fail { - print "not "; - $fail++; } sub offset ($$) { + local $::Level = $::Level + 1; my ($offset_will_be, $offset_want) = @_; my $offset_is = eval $offset_will_be; unless ($offset_is == $offset_want) { @@ -194,81 +177,60 @@ sub offset ($$) { $offset_want, $offset_is; } - fail; + fail($offset_will_be); + } else { + pass($offset_will_be); } } -print "1..17\n"; - -$fail = 0; +plan(tests => 17); -fail unless $s[7] == 5_000_000_003; # exercizes pp_stat -print "ok 1\n"; +is($s[7], 5_000_000_003, 'exercises pp_stat'); +is(-s $big0, 5_000_000_003, 'exercises pp_ftsize'); -fail unless -s $big0 == 5_000_000_003; # exercizes pp_ftsize -print "ok 2\n"; +is(-e $big0, 1); +is(-f $big0, 1); -fail unless -e $big0; -print "ok 3\n"; - -fail unless -f $big0; -print "ok 4\n"; - -open(BIG, $big0) or do { warn "open failed: $!\n"; bye }; +open(BIG, $big0) or die "open failed: $!"; binmode BIG; -fail unless seek(BIG, 4_500_000_000, $SEEK_SET); -print "ok 5\n"; +isnt(seek(BIG, 4_500_000_000, SEEK_SET), undef); offset('tell(BIG)', 4_500_000_000); -print "ok 6\n"; -fail unless seek(BIG, 1, $SEEK_CUR); -print "ok 7\n"; +isnt(seek(BIG, 1, SEEK_CUR), undef); # If you get 205_032_705 from here it means that # your tell() is returning 32-bit values since (I32)4_500_000_001 # is exactly 205_032_705. offset('tell(BIG)', 4_500_000_001); -print "ok 8\n"; -fail unless seek(BIG, -1, $SEEK_CUR); -print "ok 9\n"; +isnt(seek(BIG, -1, SEEK_CUR), undef); offset('tell(BIG)', 4_500_000_000); -print "ok 10\n"; -fail unless seek(BIG, -3, $SEEK_END); -print "ok 11\n"; +isnt(seek(BIG, -3, SEEK_END), undef); offset('tell(BIG)', 5_000_000_000); -print "ok 12\n"; my $big; -fail unless read(BIG, $big, 3) == 3; -print "ok 13\n"; +is(read(BIG, $big, 3), 3); -fail unless $big eq "big"; -print "ok 14\n"; +is($big, "big"); # 705_032_704 = (I32)5_000_000_000 # See that we don't have "big" in the 705_... spot: # that would mean that we have a wraparound. -fail unless seek(BIG, 705_032_704, $SEEK_SET); -print "ok 15\n"; +isnt(seek(BIG, 705_032_704, SEEK_SET), undef); my $zero; -fail unless read(BIG, $zero, 3) == 3; -print "ok 16\n"; - -fail unless $zero eq "\0\0\0"; -print "ok 17\n"; +is(read(BIG, $zero, 3), 3); -explain() if $fail; +is($zero, "\0\0\0"); -bye(); # does the necessary cleanup +explain() unless $::Tests_Are_Passing; END { # unlink may fail if applied directly to a large file diff --git a/t/test.pl b/t/test.pl index a558820..5f8eb98 100644 --- a/t/test.pl +++ b/t/test.pl @@ -26,6 +26,7 @@ my $Perl; # Safer version of $^X set by which_perl() $TODO = 0; $NO_ENDING = 0; +$Tests_Are_Passing = 1; # Use this instead of print to avoid interference while testing globals. sub _print { @@ -122,7 +123,12 @@ sub _ok { $out = $pass ? "ok $test" : "not ok $test"; } - $out = $out . " # TODO $TODO" if $TODO; + if ($TODO) { + $out = $out . " # TODO $TODO"; + } else { + $Tests_Are_Passing = 0 unless $pass; + } + _print "$out\n"; unless ($pass) { -- Perl5 Master Repository
