This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refactor syslfs.t and lfs.t to call bye() directly from explain() when skipping.
[perl5.git] / t / op / lfs.t
CommitLineData
ea2b5ef6
JH
1# NOTE: this file tests how large files (>2GB) work with perlio (stdio/sfio).
2# sysopen(), sysseek(), syswrite(), sysread() are tested in t/lib/syslfs.t.
4d0ed6f7 3# If you modify/add tests here, remember to update also ext/Fcntl/t/syslfs.t.
ea2b5ef6 4
817e2dcb 5BEGIN {
ea2b5ef6 6 chdir 't' if -d 't';
20822f61 7 @INC = '../lib';
9f8fdb7d
JH
8 # Don't bother if there are no quad offsets.
9 require Config; import Config;
10 if ($Config{lseeksize} < 8) {
6afb513c 11 print "1..0 # Skip: no 64-bit file offsets\n";
48ea9154 12 exit(0);
9f8fdb7d 13 }
1c25d394 14 require './test.pl';
817e2dcb
JH
15}
16
326fd4b6 17use strict;
52ece81a 18
326fd4b6
A
19our @s;
20our $fail;
21
1c25d394
NC
22my $big0 = tempfile();
23my $big1 = tempfile();
24my $big2 = tempfile();
25
93c29725 26sub zap {
6da84e39 27 close(BIG);
93c29725
JH
28}
29
30sub bye {
6c1d9365 31 zap();
6da84e39
JH
32 exit(0);
33}
34
d731b481
JH
35my $explained;
36
fcbfa962 37sub explain {
d731b481
JH
38 unless ($explained++) {
39 print <<EOM;
fcbfa962 40#
d731b481
JH
41# If the lfs (large file support: large meaning larger than two
42# gigabytes) tests are skipped or fail, it may mean either that your
43# process (or process group) is not allowed to write large files
44# (resource limits) or that the file system (the network filesystem?)
45# you are running the tests on doesn't let your user/group have large
46# files (quota) or the filesystem simply doesn't support large files.
47# You may even need to reconfigure your kernel. (This is all very
48# operating system and site-dependent.)
fcbfa962
JH
49#
50# Perl may still be able to support large files, once you have
eed7fde4 51# such a process, enough quota, and such a (file) system.
d731b481 52# It is just that the test failed now.
fcbfa962
JH
53#
54EOM
d731b481 55 }
80ed9481
NC
56 if(@_) {
57 print "1..0 # Skip: @_\n";
58 bye();
59 }
fcbfa962
JH
60}
61
0ecd3ba2
MG
62$| = 1;
63
e0a10278
JH
64print "# checking whether we have sparse files...\n";
65
05f8a9f5 66# Known have-nots.
2986a63f 67if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
86e48eb5 68 print "1..0 # Skip: no sparse files in $^O\n";
6da84e39
JH
69 bye();
70}
71
b18f8161
JH
72# Known haves that have problems running this test
73# (for example because they do not support sparse files, like UNICOS)
74if ($^O eq 'unicos') {
972720f9 75 print "1..0 # Skip: no sparse files in $^O, unable to test large files\n";
b18f8161
JH
76 bye();
77}
78
6c1d9365 79# Then try heuristically to deduce whether we have sparse files.
05f8a9f5 80
64215065
JH
81# Let's not depend on Fcntl or any other extension.
82
6c1d9365
NC
83sub SEEK_SET () {0}
84sub SEEK_CUR () {1}
85sub SEEK_END () {2}
6da84e39 86
ea2b5ef6 87# We'll start off by creating a one megabyte file which has
05f8a9f5
JH
88# only three "true" bytes. If we have sparseness, we should
89# consume less blocks than one megabyte (assuming nobody has
90# one megabyte blocks...)
817e2dcb 91
1c25d394
NC
92open(BIG, ">$big1") or
93 do { warn "open $big1 failed: $!\n"; bye };
93c29725 94binmode(BIG) or
1c25d394 95 do { warn "binmode $big1 failed: $!\n"; bye };
6c1d9365 96seek(BIG, 1_000_000, SEEK_SET) or
1c25d394 97 do { warn "seek $big1 failed: $!\n"; bye };
93c29725 98print BIG "big" or
1c25d394 99 do { warn "print $big1 failed: $!\n"; bye };
93c29725 100close(BIG) or
1c25d394 101 do { warn "close $big1 failed: $!\n"; bye };
93c29725 102
1c25d394 103my @s1 = stat($big1);
93c29725
JH
104
105print "# s1 = @s1\n";
106
1c25d394
NC
107open(BIG, ">$big2") or
108 do { warn "open $big2 failed: $!\n"; bye };
93c29725 109binmode(BIG) or
1c25d394 110 do { warn "binmode $big2 failed: $!\n"; bye };
6c1d9365
NC
111seek(BIG, 2_000_000, SEEK_SET) or
112 do { warn "seek $big2 failed: $!\n"; bye };
93c29725 113print BIG "big" or
6c1d9365 114 do { warn "print $big2 failed: $!\n"; bye };
93c29725 115close(BIG) or
6c1d9365 116 do { warn "close $big2 failed: $!\n"; bye };
93c29725 117
1c25d394 118my @s2 = stat($big2);
93c29725
JH
119
120print "# s2 = @s2\n";
121
122zap();
123
124unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 &&
411c7dd7
LB
125 $s1[11] == $s2[11] && $s1[12] == $s2[12] &&
126 $s1[12] > 0) {
6afb513c 127 print "1..0 # Skip: no sparse files?\n";
93c29725 128 bye;
817e2dcb
JH
129}
130
e0a10278
JH
131print "# we seem to have sparse files...\n";
132
817e2dcb
JH
133# By now we better be sure that we do have sparse files:
134# if we are not, the following will hog 5 gigabytes of disk. Ooops.
6afb513c 135# This may fail by producing some signal; run in a subprocess first for safety
817e2dcb 136
eed7fde4
JH
137$ENV{LC_ALL} = "C";
138
96dca4d4
NC
139my $r = system '../perl', '-e', <<"EOF";
140open my \$big, '>', q{$big0} or die qq{open $big0: $!};
141seek \$big, 5_000_000_000, 0 or die qq{seek $big0: $!};
142print \$big "big" or die qq{print $big0: $!};
143close \$big or die qq{close $big0: $!};
6afb513c
G
144exit 0;
145EOF
146
1c25d394 147open(BIG, ">$big0") or do { warn "open failed: $!\n"; bye };
817e2dcb 148binmode BIG;
6c1d9365 149if ($r or not seek(BIG, 5_000_000_000, SEEK_SET)) {
6afb513c 150 my $err = $r ? 'signal '.($r & 0x7f) : $!;
d731b481 151 explain("seeking past 2GB failed: $err");
e0a10278 152}
eed7fde4 153
fcbfa962
JH
154# Either the print or (more likely, thanks to buffering) the close will
155# fail if there are are filesize limitations (process or fs).
156my $print = print BIG "big";
e0a10278
JH
157print "# print failed: $!\n" unless $print;
158my $close = close BIG;
159print "# close failed: $!\n" unless $close;
fcbfa962 160unless ($print && $close) {
b948423f 161 if ($! =~/too large/i) {
d731b481 162 explain("writing past 2GB failed: process limits?");
b948423f 163 } elsif ($! =~ /quota/i) {
d731b481
JH
164 explain("filesystem quota limits?");
165 } else {
166 explain("error: $!");
fcbfa962 167 }
fcbfa962 168}
817e2dcb 169
1c25d394 170@s = stat($big0);
817e2dcb 171
ea2b5ef6
JH
172print "# @s\n";
173
ae178db1 174unless ($s[7] == 5_000_000_003) {
d731b481 175 explain("kernel/fs not configured to use large files?");
ae178db1
JH
176}
177
1c25d394 178sub fail {
64215065 179 print "not ";
05f8a9f5
JH
180 $fail++;
181}
182
326fd4b6
A
183sub offset ($$) {
184 my ($offset_will_be, $offset_want) = @_;
185 my $offset_is = eval $offset_will_be;
186 unless ($offset_is == $offset_want) {
187 print "# bad offset $offset_is, want $offset_want\n";
52ece81a 188 my ($offset_func) = ($offset_will_be =~ /^(\w+)/);
326fd4b6 189 if (unpack("L", pack("L", $offset_want)) == $offset_is) {
326fd4b6 190 print "# 32-bit wraparound suspected in $offset_func() since\n";
52ece81a 191 print "# $offset_want cast into 32 bits equals $offset_is.\n";
f06a04a3 192 } elsif ($offset_want - unpack("L", pack("L", $offset_want)) - 1
52ece81a 193 == $offset_is) {
f06a04a3
A
194 print "# 32-bit wraparound suspected in $offset_func() since\n";
195 printf "# %s - unpack('L', pack('L', %s)) - 1 equals %s.\n",
196 $offset_want,
197 $offset_want,
198 $offset_is;
199 }
326fd4b6
A
200 fail;
201 }
202}
203
77166d51 204print "1..17\n";
fcbfa962 205
52ece81a 206$fail = 0;
fcbfa962 207
64215065 208fail unless $s[7] == 5_000_000_003; # exercizes pp_stat
817e2dcb
JH
209print "ok 1\n";
210
1c25d394 211fail unless -s $big0 == 5_000_000_003; # exercizes pp_ftsize
817e2dcb
JH
212print "ok 2\n";
213
1c25d394 214fail unless -e $big0;
77166d51
JH
215print "ok 3\n";
216
1c25d394 217fail unless -f $big0;
77166d51
JH
218print "ok 4\n";
219
1c25d394 220open(BIG, $big0) or do { warn "open failed: $!\n"; bye };
817e2dcb
JH
221binmode BIG;
222
6c1d9365 223fail unless seek(BIG, 4_500_000_000, SEEK_SET);
77166d51 224print "ok 5\n";
817e2dcb 225
326fd4b6 226offset('tell(BIG)', 4_500_000_000);
77166d51 227print "ok 6\n";
817e2dcb 228
6c1d9365 229fail unless seek(BIG, 1, SEEK_CUR);
77166d51 230print "ok 7\n";
817e2dcb 231
326fd4b6
A
232# If you get 205_032_705 from here it means that
233# your tell() is returning 32-bit values since (I32)4_500_000_001
234# is exactly 205_032_705.
235offset('tell(BIG)', 4_500_000_001);
77166d51 236print "ok 8\n";
817e2dcb 237
6c1d9365 238fail unless seek(BIG, -1, SEEK_CUR);
77166d51 239print "ok 9\n";
817e2dcb 240
326fd4b6 241offset('tell(BIG)', 4_500_000_000);
77166d51 242print "ok 10\n";
817e2dcb 243
6c1d9365 244fail unless seek(BIG, -3, SEEK_END);
77166d51 245print "ok 11\n";
817e2dcb 246
326fd4b6 247offset('tell(BIG)', 5_000_000_000);
77166d51 248print "ok 12\n";
817e2dcb
JH
249
250my $big;
251
05f8a9f5 252fail unless read(BIG, $big, 3) == 3;
77166d51 253print "ok 13\n";
817e2dcb 254
05f8a9f5 255fail unless $big eq "big";
77166d51
JH
256print "ok 14\n";
257
258# 705_032_704 = (I32)5_000_000_000
326fd4b6
A
259# See that we don't have "big" in the 705_... spot:
260# that would mean that we have a wraparound.
6c1d9365 261fail unless seek(BIG, 705_032_704, SEEK_SET);
77166d51
JH
262print "ok 15\n";
263
264my $zero;
265
266fail unless read(BIG, $zero, 3) == 3;
267print "ok 16\n";
268
269fail unless $zero eq "\0\0\0";
270print "ok 17\n";
817e2dcb 271
d731b481 272explain() if $fail;
05f8a9f5 273
77166d51 274bye(); # does the necessary cleanup
e9a694fc 275
290be4b1 276END {
b0d0c539 277 # unlink may fail if applied directly to a large file
6c8d78fb 278 # be paranoid about leaving 5 gig files lying around
1c25d394 279 open(BIG, ">$big0"); # truncate
b0d0c539 280 close(BIG);
290be4b1
JH
281}
282
6da84e39 283# eof