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