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