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