LFS testing robustness.

p4raw-id: //depot/cfgperl@3954

diff --git a/t/op/lfs.t b/t/op/lfs.t
index 127c1a9..23f8113 100644 (file)
--- a/t/op/lfs.t
+++ b/t/op/lfs.t
@@ -2,27 +2,84 @@ BEGIN {
        eval { pack "q", 0 };
        if ($@) {
                print "1..0\n# no 64-bit types\n";
-               exit(0);
+               bitedust();
        }
 }
 
+sub bye {
+    close(BIG);
+    unlink "big";
+    exit(0);
+}
+
 # First try to figure out whether we have sparse files.
 
 if ($^O eq 'win32' || $^O eq 'vms') {
     print "1..0\n# no sparse files\n";
-    exit(0);
+    bye();
+}
+
+my $SEEK_SET;
+my $SEEK_CUR;
+my $SEEK_END;
+
+# We probe for the constants 'manually' because
+# we do not want to be dependent on any extensions.
+
+sub seek_it {
+    my ($set, $cur, $end) = @_; 
+
+    my $test = 0;
+
+    open(BIG, ">big") || do { warn "open failed: $!\n"; bye };
+    binmode BIG;
+    seek(BIG, 49, $set);
+    print BIG "X";
+    close(BIG);
+    open(BIG, "big")  || do { warn "open failed: $!\n"; bye };
+    seek(BIG, 50, $set);
+    if (tell(BIG) == 50) {
+       seek(BIG, -10, $cur);
+       if (tell(BIG) == 40) {
+           seek(BIG, -20, $end);
+           if (tell(BIG) == 30) {
+               $test = 1;
+           }
+       }
+    }
+    close(BIG);
+
+    return $test;
 }
 
-open(BIG, ">big");
+if (seek_it(0, 1, 2)) {
+    ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2);
+} elsif (seek_it(1, 2, 3)) {
+    ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (1, 2, 3);
+} else {
+    print "1..0\n# no way to seek\n";
+    bye;
+}
+
+print "# SEEK_SET = $SEEK_SET, SEEK_CUR = $SEEK_CUR, SEEK_END = $SEEK_END\n";
+
+open(BIG, ">big") || do { warn "open failed: $!\n"; bye };
+binmode BIG;
+seek(BIG, 100_000, $SEEK_SET);
+print BIG "big";
 close(BIG);
 
 my @s;
 
 @s = stat("big");
 
-unless (@s == 13 && defined $s[11] && defined $s[12]) {
+unless (@s == 13 &&
+       $s[7] == 100_003 &&
+       defined $s[11] &&
+       defined $s[12] &&
+       $s[11] * $s[12] < 100_003) {
     print "1..0\n# no sparse files\n";
-    exit(0);
+    bye();
 }
 
 # By now we better be sure that we do have sparse files:
@@ -30,9 +87,9 @@ unless (@s == 13 && defined $s[11] && defined $s[12]) {
 
 print "1..8\n";
 
-open(BIG, ">big");
+open(BIG, ">big") || do { warn "open failed: $!\n"; bye };
 binmode BIG;
-seek(BIG, 5_000_000_000, 0);
+seek(BIG, 5_000_000_000, $SEEK_SET);
 print BIG "big";
 close BIG;
 
@@ -44,25 +101,25 @@ print "ok 1\n";
 print "not " unless -s "big" == 5_000_000_003;
 print "ok 2\n";
 
-open(BIG, "big");
+open(BIG, "big") || do { warn "open failed: $!\n"; bye };
 binmode BIG;
 
-seek(BIG, 4_500_000_000, 0);
+seek(BIG, 4_500_000_000, $SEEK_SET);
 
 print "not " unless tell(BIG) == 4_500_000_000;
 print "ok 3\n";
 
-seek(BIG, 1, 1);
+seek(BIG, 1, $SEEK_CUR);
 
 print "not " unless tell(BIG) == 4_500_000_001;
 print "ok 4\n";
 
-seek(BIG, -1, 1);
+seek(BIG, -1, $SEEK_CUR);
 
 print "not " unless tell(BIG) == 4_500_000_000;
 print "ok 5\n";
 
-seek(BIG, -3, 2);
+seek(BIG, -3, $SEEK_END);
 
 print "not " unless tell(BIG) == 5_000_000_000;
 print "ok 6\n";
@@ -75,10 +132,8 @@ print "ok 7\n";
 print "not " unless $big eq "big";
 print "ok 8\n";
 
-close(BIG);
+bye();
 
-# Testing sysseek() and other sys*() io would be nice but for
-# the tests to be be portable they require the SEEK_* constants.
+# eof
 
-unlink "big";