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