This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The one that got away in #7984.
[perl5.git] / t / lib / syslfs.t
CommitLineData
ea2b5ef6 1# NOTE: this file tests how large files (>2GB) work with raw system IO.
93c29725 2# stdio: open(), tell(), seek(), print(), read() is tested in t/op/lfs.t.
ea2b5ef6
JH
3# If you modify/add tests here, remember to update also t/op/lfs.t.
4
5BEGIN {
ea2b5ef6 6 chdir 't' if -d 't';
20822f61 7 @INC = '../lib';
9f8fdb7d
JH
8 require Config; import Config;
9 # Don't bother if there are no quad offsets.
10 if ($Config{lseeksize} < 8) {
6afb513c 11 print "1..0 # Skip: no 64-bit file offsets\n";
48ea9154 12 exit(0);
9f8fdb7d 13 }
ca6e1c26 14 require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/);
ea2b5ef6
JH
15}
16
93c29725 17sub zap {
ea2b5ef6 18 close(BIG);
93c29725
JH
19 unlink("big");
20 unlink("big1");
21 unlink("big2");
22}
23
24sub bye {
25 zap();
ea2b5ef6
JH
26 exit(0);
27}
28
fcbfa962 29sub explain {
2d4389e4 30 print <<EOM;
fcbfa962
JH
31#
32# If the lfs (large file support: large meaning larger than two gigabytes)
eed7fde4
JH
33# tests are skipped or fail, it may mean either that your process
34# (or process group) is not allowed to write large files (resource
35# limits) or that the file system you are running the tests on doesn't
36# let your user/group have large files (quota) or the filesystem simply
37# doesn't support large files. You may even need to reconfigure your kernel.
38# (This is all very operating system and site-dependent.)
fcbfa962
JH
39#
40# Perl may still be able to support large files, once you have
eed7fde4 41# such a process, enough quota, and such a (file) system.
fcbfa962
JH
42#
43EOM
44}
45
e0a10278
JH
46print "# checking whether we have sparse files...\n";
47
05f8a9f5 48# Known have-nots.
86e48eb5
RS
49if ($^O eq 'MSWin32' || $^O eq 'VMS') {
50 print "1..0 # Skip: no sparse files in $^O\n";
ea2b5ef6
JH
51 bye();
52}
53
b18f8161
JH
54# Known haves that have problems running this test
55# (for example because they do not support sparse files, like UNICOS)
56if ($^O eq 'unicos') {
86e48eb5 57 print "1..0 # Skip: no sparse files in $^0, unable to test large files\n";
b18f8161
JH
58 bye();
59}
60
e0a10278 61# Then try heuristically to deduce whether we have sparse files.
05f8a9f5 62
ea2b5ef6 63# We'll start off by creating a one megabyte file which has
05f8a9f5
JH
64# only three "true" bytes. If we have sparseness, we should
65# consume less blocks than one megabyte (assuming nobody has
66# one megabyte blocks...)
ea2b5ef6 67
93c29725
JH
68sysopen(BIG, "big1", O_WRONLY|O_CREAT|O_TRUNC) or
69 do { warn "sysopen big1 failed: $!\n"; bye };
70sysseek(BIG, 1_000_000, SEEK_SET) or
71 do { warn "sysseek big1 failed: $!\n"; bye };
72syswrite(BIG, "big") or
73 do { warn "syswrite big1 failed; $!\n"; bye };
74close(BIG) or
75 do { warn "close big1 failed: $!\n"; bye };
ea2b5ef6 76
93c29725 77my @s1 = stat("big1");
ea2b5ef6 78
93c29725 79print "# s1 = @s1\n";
ea2b5ef6 80
93c29725
JH
81sysopen(BIG, "big2", O_WRONLY|O_CREAT|O_TRUNC) or
82 do { warn "sysopen big2 failed: $!\n"; bye };
83sysseek(BIG, 2_000_000, SEEK_SET) or
84 do { warn "sysseek big2 failed: $!\n"; bye };
85syswrite(BIG, "big") or
86 do { warn "syswrite big2 failed; $!\n"; bye };
87close(BIG) or
88 do { warn "close big2 failed: $!\n"; bye };
ea2b5ef6 89
93c29725 90my @s2 = stat("big2");
5cec1e3b 91
93c29725
JH
92print "# s2 = @s2\n";
93
94zap();
95
96unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 &&
97 $s1[11] == $s2[11] && $s1[12] == $s2[12]) {
6afb513c 98 print "1..0 # Skip: no sparse files?\n";
93c29725 99 bye;
ea2b5ef6
JH
100}
101
e0a10278
JH
102print "# we seem to have sparse files...\n";
103
ea2b5ef6
JH
104# By now we better be sure that we do have sparse files:
105# if we are not, the following will hog 5 gigabytes of disk. Ooops.
6afb513c 106# This may fail by producing some signal; run in a subprocess first for safety
ea2b5ef6 107
eed7fde4
JH
108$ENV{LC_ALL} = "C";
109
6afb513c
G
110my $r = system '../perl', '-I../lib', '-e', <<'EOF';
111use Fcntl qw(/^O_/ /^SEEK_/);
112sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or die $!;
113my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
114my $syswrite = syswrite(BIG, "big");
115exit 0;
116EOF
117
cc4466b7 118sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
e0a10278
JH
119 do { warn "sysopen 'big' failed: $!\n"; bye };
120my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
6afb513c
G
121unless (! $r && defined $sysseek && $sysseek == 5_000_000_000) {
122 $sysseek = 'undef' unless defined $sysseek;
123 print "1..0 # Skip: seeking past 2GB failed: ",
124 $r ? 'signal '.($r & 0x7f) : "$! (sysseek returned $sysseek)", "\n";
e0a10278
JH
125 explain();
126 bye();
127}
eed7fde4 128
fcbfa962 129# The syswrite will fail if there are are filesize limitations (process or fs).
e0a10278
JH
130my $syswrite = syswrite(BIG, "big");
131print "# syswrite failed: $! (syswrite returned ",
132 defined $syswrite ? $syswrite : 'undef', ")\n"
133 unless defined $syswrite && $syswrite == 3;
134my $close = close BIG;
135print "# close failed: $!\n" unless $close;
eed7fde4 136unless($syswrite && $close) {
b948423f 137 if ($! =~/too large/i) {
6afb513c 138 print "1..0 # Skip: writing past 2GB failed: process limits?\n";
b948423f 139 } elsif ($! =~ /quota/i) {
6afb513c 140 print "1..0 # Skip: filesystem quota limits?\n";
fcbfa962 141 }
56d29690 142 explain();
eed7fde4 143 bye();
fcbfa962 144}
ea2b5ef6
JH
145
146@s = stat("big");
147
148print "# @s\n";
149
ae178db1 150unless ($s[7] == 5_000_000_003) {
6afb513c 151 print "1..0 # Skip: not configured to use large files?\n";
ae178db1
JH
152 explain();
153 bye();
154}
155
05f8a9f5 156sub fail () {
64215065 157 print "not ";
05f8a9f5
JH
158 $fail++;
159}
160
77166d51 161print "1..17\n";
fcbfa962
JH
162
163my $fail = 0;
164
64215065 165fail unless $s[7] == 5_000_000_003; # exercizes pp_stat
ea2b5ef6
JH
166print "ok 1\n";
167
64215065 168fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize
ea2b5ef6
JH
169print "ok 2\n";
170
77166d51
JH
171fail unless -e "big";
172print "ok 3\n";
173
174fail unless -f "big";
175print "ok 4\n";
176
ea2b5ef6
JH
177sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
178
77166d51
JH
179fail unless sysseek(BIG, 4_500_000_000, SEEK_SET) == 4_500_000_000;
180print "ok 5\n";
ea2b5ef6 181
05f8a9f5 182fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
77166d51 183print "ok 6\n";
ea2b5ef6 184
77166d51
JH
185fail unless sysseek(BIG, 1, SEEK_CUR) == 4_500_000_001;
186print "ok 7\n";
ea2b5ef6 187
05f8a9f5 188fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_001;
77166d51 189print "ok 8\n";
ea2b5ef6 190
77166d51
JH
191fail unless sysseek(BIG, -1, SEEK_CUR) == 4_500_000_000;
192print "ok 9\n";
ea2b5ef6 193
05f8a9f5 194fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
77166d51 195print "ok 10\n";
ea2b5ef6 196
77166d51
JH
197fail unless sysseek(BIG, -3, SEEK_END) == 5_000_000_000;
198print "ok 11\n";
ea2b5ef6 199
05f8a9f5 200fail unless sysseek(BIG, 0, SEEK_CUR) == 5_000_000_000;
77166d51 201print "ok 12\n";
ea2b5ef6
JH
202
203my $big;
204
05f8a9f5 205fail unless sysread(BIG, $big, 3) == 3;
77166d51 206print "ok 13\n";
ea2b5ef6 207
05f8a9f5 208fail unless $big eq "big";
77166d51
JH
209print "ok 14\n";
210
211# 705_032_704 = (I32)5_000_000_000
a5853b9e 212fail unless sysseek(BIG, 705_032_704, SEEK_SET);
77166d51
JH
213print "ok 15\n";
214
215my $zero;
216
217fail unless read(BIG, $zero, 3) == 3;
218print "ok 16\n";
219
220fail unless $zero eq "\0\0\0";
221print "ok 17\n";
ea2b5ef6 222
fcbfa962 223explain if $fail;
05f8a9f5 224
77166d51 225bye(); # does the necessary cleanup
e9a694fc 226
290be4b1
JH
227END {
228 unlink "big"; # be paranoid about leaving 5 gig files lying around
229}
230
ea2b5ef6 231# eof