This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Diagnose possible quota limits.
[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.
3# If you modify/add tests here, remember to update also t/lib/syslfs.t.
4
817e2dcb 5BEGIN {
05f8a9f5 6 # Don't bother if there are no quads.
ea2b5ef6 7 eval { my $q = pack "q", 0 };
817e2dcb
JH
8 if ($@) {
9 print "1..0\n# no 64-bit types\n";
48ea9154 10 exit(0);
817e2dcb 11 }
ea2b5ef6
JH
12 chdir 't' if -d 't';
13 unshift @INC, '../lib';
9f8fdb7d
JH
14 # Don't bother if there are no quad offsets.
15 require Config; import Config;
16 if ($Config{lseeksize} < 8) {
64215065 17 print "1..0\n# no 64-bit file offsets\n";
48ea9154 18 exit(0);
9f8fdb7d 19 }
817e2dcb
JH
20}
21
6da84e39
JH
22sub bye {
23 close(BIG);
24 unlink "big";
25 exit(0);
26}
27
fcbfa962 28sub explain {
2d4389e4 29 print <<EOM;
fcbfa962
JH
30#
31# If the lfs (large file support: large meaning larger than two gigabytes)
eed7fde4
JH
32# tests are skipped or fail, it may mean either that your process
33# (or process group) is not allowed to write large files (resource
34# limits) or that the file system you are running the tests on doesn't
35# let your user/group have large files (quota) or the filesystem simply
36# doesn't support large files. You may even need to reconfigure your kernel.
37# (This is all very operating system and site-dependent.)
fcbfa962
JH
38#
39# Perl may still be able to support large files, once you have
eed7fde4 40# such a process, enough quota, and such a (file) system.
fcbfa962
JH
41#
42EOM
43}
44
05f8a9f5 45# Known have-nots.
817e2dcb
JH
46if ($^O eq 'win32' || $^O eq 'vms') {
47 print "1..0\n# no sparse files\n";
6da84e39
JH
48 bye();
49}
50
05f8a9f5
JH
51# Then try to deduce whether we have sparse files.
52
64215065
JH
53# Let's not depend on Fcntl or any other extension.
54
ea2b5ef6 55my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2);
6da84e39 56
ea2b5ef6 57# We'll start off by creating a one megabyte file which has
05f8a9f5
JH
58# only three "true" bytes. If we have sparseness, we should
59# consume less blocks than one megabyte (assuming nobody has
60# one megabyte blocks...)
817e2dcb 61
ea2b5ef6 62open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
6da84e39 63binmode BIG;
ea2b5ef6 64seek(BIG, 1_000_000, $SEEK_SET);
6da84e39 65print BIG "big";
817e2dcb
JH
66close(BIG);
67
68my @s;
69
70@s = stat("big");
71
ea2b5ef6
JH
72print "# @s\n";
73
5cec1e3b
JH
74my $BLOCKSIZE = 512; # is this really correct everywhere?
75
6da84e39 76unless (@s == 13 &&
ea2b5ef6 77 $s[7] == 1_000_003 &&
6da84e39 78 defined $s[12] &&
5cec1e3b 79 $BLOCKSIZE * $s[12] < 1_000_003) {
ea2b5ef6 80 print "1..0\n# no sparse files?\n";
6da84e39 81 bye();
817e2dcb
JH
82}
83
84# By now we better be sure that we do have sparse files:
85# if we are not, the following will hog 5 gigabytes of disk. Ooops.
86
eed7fde4
JH
87$ENV{LC_ALL} = "C";
88
ea2b5ef6 89open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
817e2dcb 90binmode BIG;
6da84e39 91seek(BIG, 5_000_000_000, $SEEK_SET);
eed7fde4 92
fcbfa962
JH
93# Either the print or (more likely, thanks to buffering) the close will
94# fail if there are are filesize limitations (process or fs).
95my $print = print BIG "big";
96my $close = close BIG if $print;
97unless ($print && $close) {
eed7fde4
JH
98 unless ($print) {
99 print "# print failed: $!\n"
100 } else {
101 print "# close failed: $!\n"
102 }
b948423f
JH
103 if ($! =~/too large/i) {
104 print "1..0\n# writing past 2GB failed: process limits?\n";
105 } elsif ($! =~ /quota/i) {
106 print "1..0\n# filesystem quota limits?\n";
fcbfa962 107 }
b948423f 108 ain();
fcbfa962
JH
109 bye();
110}
817e2dcb
JH
111
112@s = stat("big");
113
ea2b5ef6
JH
114print "# @s\n";
115
05f8a9f5 116sub fail () {
64215065 117 print "not ";
05f8a9f5
JH
118 $fail++;
119}
120
77166d51 121print "1..17\n";
fcbfa962
JH
122
123my $fail = 0;
124
64215065 125fail unless $s[7] == 5_000_000_003; # exercizes pp_stat
817e2dcb
JH
126print "ok 1\n";
127
64215065 128fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize
817e2dcb
JH
129print "ok 2\n";
130
77166d51
JH
131fail unless -e "big";
132print "ok 3\n";
133
134fail unless -f "big";
135print "ok 4\n";
136
ea2b5ef6 137open(BIG, "big") or do { warn "open failed: $!\n"; bye };
817e2dcb
JH
138binmode BIG;
139
77166d51
JH
140fail unless seek(BIG, 4_500_000_000, $SEEK_SET);
141print "ok 5\n";
817e2dcb 142
05f8a9f5 143fail unless tell(BIG) == 4_500_000_000;
77166d51 144print "ok 6\n";
817e2dcb 145
77166d51
JH
146fail unless seek(BIG, 1, $SEEK_CUR);
147print "ok 7\n";
817e2dcb 148
05f8a9f5 149fail unless tell(BIG) == 4_500_000_001;
77166d51 150print "ok 8\n";
817e2dcb 151
77166d51
JH
152fail unless seek(BIG, -1, $SEEK_CUR);
153print "ok 9\n";
817e2dcb 154
05f8a9f5 155fail unless tell(BIG) == 4_500_000_000;
77166d51 156print "ok 10\n";
817e2dcb 157
77166d51
JH
158fail unless seek(BIG, -3, $SEEK_END);
159print "ok 11\n";
817e2dcb 160
05f8a9f5 161fail unless tell(BIG) == 5_000_000_000;
77166d51 162print "ok 12\n";
817e2dcb
JH
163
164my $big;
165
05f8a9f5 166fail unless read(BIG, $big, 3) == 3;
77166d51 167print "ok 13\n";
817e2dcb 168
05f8a9f5 169fail unless $big eq "big";
77166d51
JH
170print "ok 14\n";
171
172# 705_032_704 = (I32)5_000_000_000
173fail unless seek(BIG, 705_032_704, $SEEK_SET);
174print "ok 15\n";
175
176my $zero;
177
178fail unless read(BIG, $zero, 3) == 3;
179print "ok 16\n";
180
181fail unless $zero eq "\0\0\0";
182print "ok 17\n";
817e2dcb 183
fcbfa962 184explain if $fail;
05f8a9f5 185
77166d51 186bye(); # does the necessary cleanup
e9a694fc 187
6da84e39 188# eof