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 { |
05f8a9f5 |
6 | # Don't bother if there are no quads. |
ea2b5ef6 |
7 | eval { my $q = pack "q", 0 }; |
817e2dcb |
8 | if ($@) { |
9 | print "1..0\n# no 64-bit types\n"; |
48ea9154 |
10 | exit(0); |
817e2dcb |
11 | } |
ea2b5ef6 |
12 | chdir 't' if -d 't'; |
13 | unshift @INC, '../lib'; |
9f8fdb7d |
14 | # Don't bother if there are no quad offsets. |
15 | require Config; import Config; |
16 | if ($Config{lseeksize} < 8) { |
64215065 |
17 | print "1..0\n# no 64-bit file offsets\n"; |
48ea9154 |
18 | exit(0); |
9f8fdb7d |
19 | } |
817e2dcb |
20 | } |
21 | |
6da84e39 |
22 | sub bye { |
23 | close(BIG); |
24 | unlink "big"; |
25 | exit(0); |
26 | } |
27 | |
fcbfa962 |
28 | sub explain { |
2d4389e4 |
29 | print <<EOM; |
fcbfa962 |
30 | # |
31 | # If the lfs (large file support: large meaning larger than two gigabytes) |
eed7fde4 |
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 |
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 |
41 | # |
42 | EOM |
43 | } |
44 | |
05f8a9f5 |
45 | # Known have-nots. |
817e2dcb |
46 | if ($^O eq 'win32' || $^O eq 'vms') { |
47 | print "1..0\n# no sparse files\n"; |
6da84e39 |
48 | bye(); |
49 | } |
50 | |
05f8a9f5 |
51 | # Then try to deduce whether we have sparse files. |
52 | |
64215065 |
53 | # Let's not depend on Fcntl or any other extension. |
54 | |
ea2b5ef6 |
55 | my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2); |
6da84e39 |
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...) |
817e2dcb |
61 | |
ea2b5ef6 |
62 | open(BIG, ">big") or do { warn "open failed: $!\n"; bye }; |
6da84e39 |
63 | binmode BIG; |
ea2b5ef6 |
64 | seek(BIG, 1_000_000, $SEEK_SET); |
6da84e39 |
65 | print BIG "big"; |
817e2dcb |
66 | close(BIG); |
67 | |
68 | my @s; |
69 | |
70 | @s = stat("big"); |
71 | |
ea2b5ef6 |
72 | print "# @s\n"; |
73 | |
2f3a7380 |
74 | # Is there a portable way to find out what's the unit of st_blocks? |
75 | |
76 | my $BLOCKSIZE = 512; |
77 | |
78 | $BLOCKSIZE = 4096 if $^O eq 'unicos'; |
5cec1e3b |
79 | |
6da84e39 |
80 | unless (@s == 13 && |
ea2b5ef6 |
81 | $s[7] == 1_000_003 && |
6da84e39 |
82 | defined $s[12] && |
5cec1e3b |
83 | $BLOCKSIZE * $s[12] < 1_000_003) { |
ea2b5ef6 |
84 | print "1..0\n# no sparse files?\n"; |
6da84e39 |
85 | bye(); |
817e2dcb |
86 | } |
87 | |
88 | # By now we better be sure that we do have sparse files: |
89 | # if we are not, the following will hog 5 gigabytes of disk. Ooops. |
90 | |
eed7fde4 |
91 | $ENV{LC_ALL} = "C"; |
92 | |
ea2b5ef6 |
93 | open(BIG, ">big") or do { warn "open failed: $!\n"; bye }; |
817e2dcb |
94 | binmode BIG; |
6da84e39 |
95 | seek(BIG, 5_000_000_000, $SEEK_SET); |
eed7fde4 |
96 | |
fcbfa962 |
97 | # Either the print or (more likely, thanks to buffering) the close will |
98 | # fail if there are are filesize limitations (process or fs). |
99 | my $print = print BIG "big"; |
100 | my $close = close BIG if $print; |
101 | unless ($print && $close) { |
eed7fde4 |
102 | unless ($print) { |
103 | print "# print failed: $!\n" |
104 | } else { |
105 | print "# close failed: $!\n" |
106 | } |
b948423f |
107 | if ($! =~/too large/i) { |
108 | print "1..0\n# writing past 2GB failed: process limits?\n"; |
109 | } elsif ($! =~ /quota/i) { |
110 | print "1..0\n# filesystem quota limits?\n"; |
fcbfa962 |
111 | } |
56d29690 |
112 | explain(); |
fcbfa962 |
113 | bye(); |
114 | } |
817e2dcb |
115 | |
116 | @s = stat("big"); |
117 | |
ea2b5ef6 |
118 | print "# @s\n"; |
119 | |
05f8a9f5 |
120 | sub fail () { |
64215065 |
121 | print "not "; |
05f8a9f5 |
122 | $fail++; |
123 | } |
124 | |
77166d51 |
125 | print "1..17\n"; |
fcbfa962 |
126 | |
127 | my $fail = 0; |
128 | |
64215065 |
129 | fail unless $s[7] == 5_000_000_003; # exercizes pp_stat |
817e2dcb |
130 | print "ok 1\n"; |
131 | |
64215065 |
132 | fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize |
817e2dcb |
133 | print "ok 2\n"; |
134 | |
77166d51 |
135 | fail unless -e "big"; |
136 | print "ok 3\n"; |
137 | |
138 | fail unless -f "big"; |
139 | print "ok 4\n"; |
140 | |
ea2b5ef6 |
141 | open(BIG, "big") or do { warn "open failed: $!\n"; bye }; |
817e2dcb |
142 | binmode BIG; |
143 | |
77166d51 |
144 | fail unless seek(BIG, 4_500_000_000, $SEEK_SET); |
145 | print "ok 5\n"; |
817e2dcb |
146 | |
05f8a9f5 |
147 | fail unless tell(BIG) == 4_500_000_000; |
77166d51 |
148 | print "ok 6\n"; |
817e2dcb |
149 | |
77166d51 |
150 | fail unless seek(BIG, 1, $SEEK_CUR); |
151 | print "ok 7\n"; |
817e2dcb |
152 | |
05f8a9f5 |
153 | fail unless tell(BIG) == 4_500_000_001; |
77166d51 |
154 | print "ok 8\n"; |
817e2dcb |
155 | |
77166d51 |
156 | fail unless seek(BIG, -1, $SEEK_CUR); |
157 | print "ok 9\n"; |
817e2dcb |
158 | |
05f8a9f5 |
159 | fail unless tell(BIG) == 4_500_000_000; |
77166d51 |
160 | print "ok 10\n"; |
817e2dcb |
161 | |
77166d51 |
162 | fail unless seek(BIG, -3, $SEEK_END); |
163 | print "ok 11\n"; |
817e2dcb |
164 | |
05f8a9f5 |
165 | fail unless tell(BIG) == 5_000_000_000; |
77166d51 |
166 | print "ok 12\n"; |
817e2dcb |
167 | |
168 | my $big; |
169 | |
05f8a9f5 |
170 | fail unless read(BIG, $big, 3) == 3; |
77166d51 |
171 | print "ok 13\n"; |
817e2dcb |
172 | |
05f8a9f5 |
173 | fail unless $big eq "big"; |
77166d51 |
174 | print "ok 14\n"; |
175 | |
176 | # 705_032_704 = (I32)5_000_000_000 |
177 | fail unless seek(BIG, 705_032_704, $SEEK_SET); |
178 | print "ok 15\n"; |
179 | |
180 | my $zero; |
181 | |
182 | fail unless read(BIG, $zero, 3) == 3; |
183 | print "ok 16\n"; |
184 | |
185 | fail unless $zero eq "\0\0\0"; |
186 | print "ok 17\n"; |
817e2dcb |
187 | |
fcbfa962 |
188 | explain if $fail; |
05f8a9f5 |
189 | |
77166d51 |
190 | bye(); # does the necessary cleanup |
e9a694fc |
191 | |
6da84e39 |
192 | # eof |