diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 1999-11-13 13:46:38 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 1999-11-13 13:46:38 +0000 |
commit | e0a10278435e0dff75e2ea63cd1637e4c4b4296c (patch) | |
tree | ad43b5928c9b9fa9401c344b50c28a4bd1cb24ed /t/op/lfs.t | |
parent | 3b555130a80528984c94489c5f5029398cb57e01 (diff) | |
download | perl-e0a10278435e0dff75e2ea63cd1637e4c4b4296c.tar.gz |
Try to fix largefileness so that it "works" without a quad IV.
p4raw-id: //depot/cfgperl@4559
Diffstat (limited to 't/op/lfs.t')
-rw-r--r-- | t/op/lfs.t | 25 |
1 files changed, 15 insertions, 10 deletions
diff --git a/t/op/lfs.t b/t/op/lfs.t index 140846f7a2..0d6d027743 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -36,20 +36,22 @@ sub explain { EOM } +print "# checking whether we have sparse files...\n"; + # Known have-nots. if ($^O eq 'win32' || $^O eq 'vms') { - print "1..0\n# no sparse files\n"; + print "1..0\n# no sparse files (because this is $^O) \n"; bye(); } # 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\n# large files known to work but unable to test them here\n"; + print "1..0\n# large files known to work but unable to test them here ($^O)\n"; bye(); } -# Then try to deduce whether we have sparse files. +# Then try to heuristically deduce whether we have sparse files. # Let's not depend on Fcntl or any other extension. @@ -82,6 +84,8 @@ unless (@s == 13 && bye(); } +print "# we seem to have sparse files...\n"; + # By now we better be sure that we do have sparse files: # if we are not, the following will hog 5 gigabytes of disk. Ooops. @@ -89,18 +93,19 @@ $ENV{LC_ALL} = "C"; open(BIG, ">big") or do { warn "open failed: $!\n"; bye }; binmode BIG; -seek(BIG, 5_000_000_000, $SEEK_SET); +unless (seek(BIG, 5_000_000_000, $SEEK_SET)) { + print "1..0\n# seeking past 2GB failed: $!\n"; + explain(); + bye(); +} # Either the print or (more likely, thanks to buffering) the close will # fail if there are are filesize limitations (process or fs). my $print = print BIG "big"; -my $close = close BIG if $print; +print "# print failed: $!\n" unless $print; +my $close = close BIG; +print "# close failed: $!\n" unless $close; unless ($print && $close) { - unless ($print) { - print "# print failed: $!\n" - } else { - print "# close failed: $!\n" - } if ($! =~/too large/i) { print "1..0\n# writing past 2GB failed: process limits?\n"; } elsif ($! =~ /quota/i) { |