X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Flfs.t;h=feee8cc9b3fb133849233e6f96bee7a9655d067b;hb=20822f61cc01ab34be1e17db483aceb9d5ec8fb7;hp=e704f6f57b6e1ef71a528aa6d5a21a69b083b15d;hpb=93c2972558e0fa3d8125e6ff3777a99f69f25dcc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/lfs.t b/t/op/lfs.t index e704f6f..feee8cc 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -4,11 +4,11 @@ BEGIN { chdir 't' if -d 't'; - unshift @INC, '../lib'; + @INC = '../lib'; # Don't bother if there are no quad offsets. require Config; import Config; if ($Config{lseeksize} < 8) { - print "1..0\n# no 64-bit file offsets\n"; + print "1..0 # Skip: no 64-bit file offsets\n"; exit(0); } } @@ -46,14 +46,14 @@ 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 (because this is $^O) \n"; + print "1..0 # Skip: 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 ($^O)\n"; + print "1..0 # Skip: large files known to work but unable to test them here ($^O)\n"; bye(); } @@ -102,7 +102,7 @@ zap(); unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 && $s1[11] == $s2[11] && $s1[12] == $s2[12]) { - print "1..0\n#no sparse files?\n"; + print "1..0 # Skip: no sparse files?\n"; bye; } @@ -110,13 +110,22 @@ 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. +# This may fail by producing some signal; run in a subprocess first for safety $ENV{LC_ALL} = "C"; +my $r = system '../perl', '-e', <<'EOF'; +open(BIG, ">big"); +seek(BIG, 5_000_000_000, 0); +print BIG "big"; +exit 0; +EOF + open(BIG, ">big") or do { warn "open failed: $!\n"; bye }; binmode BIG; -unless (seek(BIG, 5_000_000_000, $SEEK_SET)) { - print "1..0\n# seeking past 2GB failed: $!\n"; +if ($r or not seek(BIG, 5_000_000_000, $SEEK_SET)) { + my $err = $r ? 'signal '.($r & 0x7f) : $!; + print "1..0 # Skip: seeking past 2GB failed: $err\n"; explain(); bye(); } @@ -129,9 +138,9 @@ my $close = close BIG; print "# close failed: $!\n" unless $close; unless ($print && $close) { if ($! =~/too large/i) { - print "1..0\n# writing past 2GB failed: process limits?\n"; + print "1..0 # Skip: writing past 2GB failed: process limits?\n"; } elsif ($! =~ /quota/i) { - print "1..0\n# filesystem quota limits?\n"; + print "1..0 # Skip: filesystem quota limits?\n"; } explain(); bye(); @@ -142,7 +151,7 @@ unless ($print && $close) { print "# @s\n"; unless ($s[7] == 5_000_000_003) { - print "1..0\n# not configured to use large files?\n"; + print "1..0 # Skip: not configured to use large files?\n"; explain(); bye(); }