1 # NOTE: this file tests how large files (>2GB) work with perlio (or stdio).
2 # sysopen(), sysseek(), syswrite(), sysread() are tested in t/lib/syslfs.t.
3 # If you modify/add tests here, remember to update also ext/Fcntl/t/syslfs.t.
10 # Don't bother if there are no quad offsets.
11 skip_all('no 64-bit file offsets')
12 if $Config::Config{lseeksize} < 8;
19 my $big0 = tempfile();
20 my $big1 = tempfile();
21 my $big2 = tempfile();
26 unless ($explained++) {
29 # If the lfs (large file support: large meaning larger than two
30 # gigabytes) tests are skipped or fail, it may mean either that your
31 # process (or process group) is not allowed to write large files
32 # (resource limits) or that the file system (the network filesystem?)
33 # you are running the tests on doesn't let your user/group have large
34 # files (quota) or the filesystem simply doesn't support large files.
35 # You may even need to reconfigure your kernel. (This is all very
36 # operating system and site-dependent.)
38 # Perl may still be able to support large files, once you have
39 # such a process, enough quota, and such a (file) system.
40 # It is just that the test failed now.
51 print "# checking whether we have sparse files...\n";
54 if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
55 skip_all("no sparse files in $^O");
58 # Known haves that have problems running this test
59 # (for example because they do not support sparse files, like UNICOS)
60 if ($^O eq 'unicos') {
61 skip_all("no sparse files in $^O, unable to test large files");
64 # Then try heuristically to deduce whether we have sparse files.
66 # Let's not depend on Fcntl or any other extension.
72 # We'll start off by creating a one megabyte file which has
73 # only three "true" bytes. If we have sparseness, we should
74 # consume less blocks than one megabyte (assuming nobody has
75 # one megabyte blocks...)
77 open(BIG, ">$big1") or
78 die "open $big1 failed: $!";
80 die "binmode $big1 failed: $!";
81 seek(BIG, 1_000_000, SEEK_SET) or
82 die "seek $big1 failed: $!";
84 die "print $big1 failed: $!";
86 die "close $big1 failed: $!";
92 open(BIG, ">$big2") or
93 die "open $big2 failed: $!";
95 die "binmode $big2 failed: $!";
96 seek(BIG, 2_000_000, SEEK_SET) or
97 die "seek $big2 failed: $!";
99 die "print $big2 failed: $!";
101 die "close $big2 failed: $!";
103 my @s2 = stat($big2);
105 print "# s2 = @s2\n";
107 unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 &&
108 $s1[11] == $s2[11] && $s1[12] == $s2[12] &&
110 skip_all("no sparse files?");
113 print "# we seem to have sparse files...\n";
115 # By now we better be sure that we do have sparse files:
116 # if we are not, the following will hog 5 gigabytes of disk. Ooops.
117 # This may fail by producing some signal; run in a subprocess first for safety
121 my $r = system '../perl', '-e', <<"EOF";
122 open my \$big, '>', q{$big0} or die qq{open $big0: $!};
123 seek \$big, 5_000_000_000, 0 or die qq{seek $big0: $!};
124 print \$big "big" or die qq{print $big0: $!};
125 close \$big or die qq{close $big0: $!};
129 open(BIG, ">$big0") or die "open failed: $!";
131 if ($r or not seek(BIG, 5_000_000_000, SEEK_SET)) {
132 my $err = $r ? 'signal '.($r & 0x7f) : $!;
133 explain("seeking past 2GB failed: $err");
136 # Either the print or (more likely, thanks to buffering) the close will
137 # fail if there are are filesize limitations (process or fs).
138 my $print = print BIG "big";
139 print "# print failed: $!\n" unless $print;
140 my $close = close BIG;
141 print "# close failed: $!\n" unless $close;
142 unless ($print && $close) {
143 if ($! =~/too large/i) {
144 explain("writing past 2GB failed: process limits?");
145 } elsif ($! =~ /quota/i) {
146 explain("filesystem quota limits?");
148 explain("error: $!");
156 unless ($s[7] == 5_000_000_003) {
157 explain("kernel/fs not configured to use large files?");
161 local $::Level = $::Level + 1;
162 my ($offset_will_be, $offset_want) = @_;
163 my $offset_is = eval $offset_will_be;
164 unless ($offset_is == $offset_want) {
165 print "# bad offset $offset_is, want $offset_want\n";
166 my ($offset_func) = ($offset_will_be =~ /^(\w+)/);
167 if (unpack("L", pack("L", $offset_want)) == $offset_is) {
168 print "# 32-bit wraparound suspected in $offset_func() since\n";
169 print "# $offset_want cast into 32 bits equals $offset_is.\n";
170 } elsif ($offset_want - unpack("L", pack("L", $offset_want)) - 1
172 print "# 32-bit wraparound suspected in $offset_func() since\n";
173 printf "# %s - unpack('L', pack('L', %s)) - 1 equals %s.\n",
178 fail($offset_will_be);
180 pass($offset_will_be);
186 is($s[7], 5_000_000_003, 'exercises pp_stat');
187 is(-s $big0, 5_000_000_003, 'exercises pp_ftsize');
192 open(BIG, $big0) or die "open failed: $!";
195 isnt(seek(BIG, 4_500_000_000, SEEK_SET), undef);
197 offset('tell(BIG)', 4_500_000_000);
199 isnt(seek(BIG, 1, SEEK_CUR), undef);
201 # If you get 205_032_705 from here it means that
202 # your tell() is returning 32-bit values since (I32)4_500_000_001
203 # is exactly 205_032_705.
204 offset('tell(BIG)', 4_500_000_001);
206 isnt(seek(BIG, -1, SEEK_CUR), undef);
208 offset('tell(BIG)', 4_500_000_000);
210 isnt(seek(BIG, -3, SEEK_END), undef);
212 offset('tell(BIG)', 5_000_000_000);
216 is(read(BIG, $big, 3), 3);
220 # 705_032_704 = (I32)5_000_000_000
221 # See that we don't have "big" in the 705_... spot:
222 # that would mean that we have a wraparound.
223 isnt(seek(BIG, 705_032_704, SEEK_SET), undef);
227 is(read(BIG, $zero, 3), 3);
231 explain() unless $::Tests_Are_Passing;
234 # unlink may fail if applied directly to a large file
235 # be paranoid about leaving 5 gig files lying around
236 open(BIG, ">$big0"); # truncate