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