This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix MM_VMS.pm for space-delimited lists
[perl5.git] / t / lib / syslfs.t
CommitLineData
ea2b5ef6
JH
1# NOTE: this file tests how large files (>2GB) work with raw system IO.
2# open(), tell(), seek(), print(), read() are tested in t/op/lfs.t.
3# If you modify/add tests here, remember to update also t/op/lfs.t.
4
5BEGIN {
05f8a9f5 6 # Don't bother if there are no quads.
ea2b5ef6
JH
7 eval { my $q = pack "q", 0 };
8 if ($@) {
9 print "1..0\n# no 64-bit types\n";
48ea9154 10 exit(0);
ea2b5ef6
JH
11 }
12 chdir 't' if -d 't';
13 unshift @INC, '../lib';
9f8fdb7d
JH
14 require Config; import Config;
15 # Don't bother if there are no quad offsets.
16 if ($Config{lseeksize} < 8) {
64215065 17 print "1..0\n# no 64-bit file offsets\n";
48ea9154 18 exit(0);
9f8fdb7d 19 }
ea2b5ef6
JH
20 require Fcntl; import Fcntl;
21}
22
23sub bye {
24 close(BIG);
25 unlink "big";
26 exit(0);
27}
28
05f8a9f5 29# Known have-nots.
ea2b5ef6
JH
30if ($^O eq 'win32' || $^O eq 'vms') {
31 print "1..0\n# no sparse files\n";
32 bye();
33}
34
05f8a9f5
JH
35# Then try to deduce whether we have sparse files.
36
ea2b5ef6 37# We'll start off by creating a one megabyte file which has
05f8a9f5
JH
38# only three "true" bytes. If we have sparseness, we should
39# consume less blocks than one megabyte (assuming nobody has
40# one megabyte blocks...)
ea2b5ef6 41
cc4466b7 42sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
ea2b5ef6
JH
43 do { warn "sysopen failed: $!\n"; bye };
44sysseek(BIG, 1_000_000, SEEK_SET);
45syswrite(BIG, "big");
46close(BIG);
47
48my @s;
49
50@s = stat("big");
51
52print "# @s\n";
53
5cec1e3b
JH
54my $BLOCKSIZE = 512; # is this really correct everywhere?
55
ea2b5ef6
JH
56unless (@s == 13 &&
57 $s[7] == 1_000_003 &&
ea2b5ef6 58 defined $s[12] &&
5cec1e3b 59 $BLOCKSIZE * $s[12] < 1_000_003) {
ea2b5ef6
JH
60 print "1..0\n# no sparse files?\n";
61 bye();
62}
63
64# By now we better be sure that we do have sparse files:
65# if we are not, the following will hog 5 gigabytes of disk. Ooops.
66
67print "1..8\n";
68
05f8a9f5
JH
69my $fail = 0;
70
cc4466b7 71sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
ea2b5ef6
JH
72 do { warn "sysopen failed: $!\n"; bye };
73sysseek(BIG, 5_000_000_000, SEEK_SET);
74syswrite(BIG, "big");
75close BIG;
76
77@s = stat("big");
78
79print "# @s\n";
80
05f8a9f5 81sub fail () {
64215065 82 print "not ";
05f8a9f5
JH
83 $fail++;
84}
85
64215065 86fail unless $s[7] == 5_000_000_003; # exercizes pp_stat
ea2b5ef6
JH
87print "ok 1\n";
88
64215065 89fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize
ea2b5ef6
JH
90print "ok 2\n";
91
92sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
93
94sysseek(BIG, 4_500_000_000, SEEK_SET);
95
05f8a9f5 96fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
ea2b5ef6
JH
97print "ok 3\n";
98
99sysseek(BIG, 1, SEEK_CUR);
100
05f8a9f5 101fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_001;
ea2b5ef6
JH
102print "ok 4\n";
103
104sysseek(BIG, -1, SEEK_CUR);
105
05f8a9f5 106fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
ea2b5ef6
JH
107print "ok 5\n";
108
109sysseek(BIG, -3, SEEK_END);
110
05f8a9f5 111fail unless sysseek(BIG, 0, SEEK_CUR) == 5_000_000_000;
ea2b5ef6
JH
112print "ok 6\n";
113
114my $big;
115
05f8a9f5 116fail unless sysread(BIG, $big, 3) == 3;
ea2b5ef6
JH
117print "ok 7\n";
118
05f8a9f5 119fail unless $big eq "big";
ea2b5ef6
JH
120print "ok 8\n";
121
05f8a9f5
JH
122if ($fail) {
123 print STDERR <<EOM;
124#
e9a694fc 125# If the lfs (large file support) tests fail, it may mean that
05f8a9f5
JH
126# the *file system* you are running the tests on doesn't support
127# large files (files larger than two gigabytes). Perl may still
128# be able to support such files, once you have such a file system.
129#
130EOM
131}
132
e9a694fc
JH
133bye();
134
ea2b5ef6 135# eof