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