diff options
author | M. J. T. Guy <mjtg@cus.cam.ac.uk> | 2000-07-24 19:04:28 +0100 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2000-07-25 14:02:03 +0000 |
commit | 6afb513cb714d9103a8b829d12736d6935324245 (patch) | |
tree | caee2cd9dd17ad42cda3bdf92db2c17daa7a0b1f /t/op/lfs.t | |
parent | 4ac469dc3d5bdda48d1fc1e1ea92a82232cc5603 (diff) | |
download | perl-6afb513cb714d9103a8b829d12736d6935324245.tar.gz |
Make large file tests deal with SIGXFSZ
Message-Id: <E13GleW-0000fr-00@libra.cus.cam.ac.uk>
p4raw-id: //depot/perl@6436
Diffstat (limited to 't/op/lfs.t')
-rw-r--r-- | t/op/lfs.t | 27 |
1 files changed, 18 insertions, 9 deletions
diff --git a/t/op/lfs.t b/t/op/lfs.t index e704f6f57b..97c920c2cf 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -8,7 +8,7 @@ BEGIN { # 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(); } |