Large file support testing.

p4raw-id: //depot/cfgperl@3947

3 files changed, 87 insertions, 2 deletions

diff --git a/MANIFEST b/MANIFEST
index ea8d36e99b..b6472fbae3 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1240,6 +1240,7 @@ t/op/index.t		See if index works
 t/op/int.t		See if int works
 t/op/join.t		See if join works
 t/op/lex_assign.t	See if ops involving lexicals or pad temps work
+t/op/lfs.t		See if large files work
 t/op/list.t		See if array lists work
 t/op/local.t		See if local works
 t/op/lop.t		See if logical operators work
diff --git a/t/op/64bit.t b/t/op/64bit.t
index f49b5e47f6..10f570a4ad 100644
--- a/t/op/64bit.t
+++ b/t/op/64bit.t
@@ -8,8 +8,8 @@ BEGIN {
 
 # This could use a lot of more tests.
 #
-# Nota bene: bit operations are not 64-bit clean.  See the beginning
-# of pp.c and the explanation next to IBW/UBW.
+# Nota bene: bit operations (&, |, ^, ~, <<, >>, vec) are not 64-bit clean.
+# See the beginning of pp.c and the explanation next to IBW/UBW.
 
 print "1..30\n";
 
diff --git a/t/op/lfs.t b/t/op/lfs.t
new file mode 100644
index 0000000000..127c1a9d5a
--- /dev/null
+++ b/t/op/lfs.t
@@ -0,0 +1,84 @@
+BEGIN {
+	eval { pack "q", 0 };
+	if ($@) {
+		print "1..0\n# no 64-bit types\n";
+		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);
+}
+
+open(BIG, ">big");
+close(BIG);
+
+my @s;
+
+@s = stat("big");
+
+unless (@s == 13 && defined $s[11] && defined $s[12]) {
+    print "1..0\n# no sparse files\n";
+    exit(0);
+}
+
+# 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.
+
+print "1..8\n";
+
+open(BIG, ">big");
+binmode BIG;
+seek(BIG, 5_000_000_000, 0);
+print BIG "big";
+close BIG;
+
+@s = stat("big");
+
+print "not " unless $s[7] == 5_000_000_003;
+print "ok 1\n";
+
+print "not " unless -s "big" == 5_000_000_003;
+print "ok 2\n";
+
+open(BIG, "big");
+binmode BIG;
+
+seek(BIG, 4_500_000_000, 0);
+
+print "not " unless tell(BIG) == 4_500_000_000;
+print "ok 3\n";
+
+seek(BIG, 1, 1);
+
+print "not " unless tell(BIG) == 4_500_000_001;
+print "ok 4\n";
+
+seek(BIG, -1, 1);
+
+print "not " unless tell(BIG) == 4_500_000_000;
+print "ok 5\n";
+
+seek(BIG, -3, 2);
+
+print "not " unless tell(BIG) == 5_000_000_000;
+print "ok 6\n";
+
+my $big;
+
+print "not " unless read(BIG, $big, 3) == 3;
+print "ok 7\n";
+
+print "not " unless $big eq "big";
+print "ok 8\n";
+
+close(BIG);
+
+# Testing sysseek() and other sys*() io would be nice but for
+# the tests to be be portable they require the SEEK_* constants.
+
+unlink "big";
+