X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/0e06870bf080a38cda51c06c6612359afc2334e1..a1325b902d57aa7a99bed3d2ec0fa5ce42836207:/t/op/lfs.t diff --git a/t/op/lfs.t b/t/op/lfs.t index 0a1c399..c53a9eb 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -1,34 +1,24 @@ -# NOTE: this file tests how large files (>2GB) work with perlio (stdio/sfio). +# NOTE: this file tests how large files (>2GB) work with perlio (or stdio). # sysopen(), sysseek(), syswrite(), sysread() are tested in t/lib/syslfs.t. -# If you modify/add tests here, remember to update also t/lib/syslfs.t. +# If you modify/add tests here, remember to update also ext/Fcntl/t/syslfs.t. BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + require './test.pl'; + set_up_inc('../lib'); + require Config; # Don't bother if there are no quad offsets. - require Config; import Config; - if ($Config{lseeksize} < 8) { - print "1..0 # Skip: no 64-bit file offsets\n"; - exit(0); - } + skip_all('no 64-bit file offsets') + if $Config::Config{lseeksize} < 8; } use strict; our @s; -our $fail; -sub zap { - close(BIG); - unlink("big"); - unlink("big1"); - unlink("big2"); -} - -sub bye { - zap(); - exit(0); -} +my $big0 = tempfile(); +my $big1 = tempfile(); +my $big2 = tempfile(); my $explained; @@ -51,71 +41,73 @@ sub explain { # EOM } - print "1..0 # Skip: @_\n" if @_; + if (@_) { + skip_all(@_); + } } +$| = 1; + print "# checking whether we have sparse files...\n"; # Known have-nots. -if ($^O eq 'MSWin32' || $^O eq 'VMS') { - print "1..0 # Skip: no sparse files in $^O\n"; - bye(); +if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') { + 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(); + 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 # consume less blocks than one megabyte (assuming nobody has # one megabyte blocks...) -open(BIG, ">big1") or - do { warn "open big1 failed: $!\n"; bye }; +open(BIG, ">$big1") or + 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"); +my @s1 = stat($big1); print "# s1 = @s1\n"; -open(BIG, ">big2") or - do { warn "open big2 failed: $!\n"; bye }; +open(BIG, ">$big2") or + 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"); +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]) { - print "1..0 # Skip: no sparse files?\n"; - bye; + $s1[11] == $s2[11] && $s1[12] == $s2[12] && + $s1[12] > 0) { + skip_all("no sparse files?"); } print "# we seem to have sparse files...\n"; @@ -126,23 +118,23 @@ print "# we seem to have sparse files...\n"; $ENV{LC_ALL} = "C"; -my $r = system '../perl', '-e', <<'EOF'; -open(BIG, ">big"); -seek(BIG, 5_000_000_000, 0); -print BIG "big"; +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, ">big") 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 -# fail if there are are filesize limitations (process or fs). +# fail if there are filesize limitations (process or fs). my $print = print BIG "big"; print "# print failed: $!\n" unless $print; my $close = close BIG; @@ -155,24 +147,18 @@ unless ($print && $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 $::Level = $::Level + 1; my ($offset_will_be, $offset_want) = @_; my $offset_is = eval $offset_will_be; unless ($offset_is == $offset_want) { @@ -189,84 +175,66 @@ sub offset ($$) { $offset_want, $offset_is; } - fail; + fail($offset_will_be); + } else { + pass($offset_will_be); } } -print "1..17\n"; - -$fail = 0; - -fail unless $s[7] == 5_000_000_003; # exercizes pp_stat -print "ok 1\n"; +plan(tests => 17); -fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize -print "ok 2\n"; +is($s[7], 5_000_000_003, 'exercises pp_stat'); +is(-s $big0, 5_000_000_003, 'exercises pp_ftsize'); -fail unless -e "big"; -print "ok 3\n"; +is(-e $big0, 1); +is(-f $big0, 1); -fail unless -f "big"; -print "ok 4\n"; - -open(BIG, "big") 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 "big"; # be paranoid about leaving 5 gig files lying around + # unlink may fail if applied directly to a large file + # be paranoid about leaving 5 gig files lying around + open(BIG, ">$big0"); # truncate + close(BIG); } # eof