This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Portable blocksize (replaces #4171).
[perl5.git] / t / lib / syslfs.t
CommitLineData
ea2b5ef6
JH
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
5BEGIN {
05f8a9f5 6 # Don't bother if there are no quads.
ea2b5ef6
JH
7 eval { my $q = pack "q", 0 };
8 if ($@) {
9 print "1..0\n# no 64-bit types\n";
48ea9154 10 exit(0);
ea2b5ef6
JH
11 }
12 chdir 't' if -d 't';
13 unshift @INC, '../lib';
9f8fdb7d
JH
14 require Config; import Config;
15 # Don't bother if there are no quad offsets.
16 if ($Config{lseeksize} < 8) {
64215065 17 print "1..0\n# no 64-bit file offsets\n";
48ea9154 18 exit(0);
9f8fdb7d 19 }
ea2b5ef6
JH
20 require Fcntl; import Fcntl;
21}
22
23sub bye {
24 close(BIG);
25 unlink "big";
26 exit(0);
27}
28
fcbfa962 29sub 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#
43EOM
44}
45
05f8a9f5 46# Known have-nots.
ea2b5ef6
JH
47if ($^O eq 'win32' || $^O eq 'vms') {
48 print "1..0\n# no sparse files\n";
49 bye();
50}
51
05f8a9f5
JH
52# Then try to deduce whether we have sparse files.
53
ea2b5ef6 54# We'll start off by creating a one megabyte file which has
05f8a9f5
JH
55# only three "true" bytes. If we have sparseness, we should
56# consume less blocks than one megabyte (assuming nobody has
57# one megabyte blocks...)
ea2b5ef6 58
cc4466b7 59sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
ea2b5ef6
JH
60 do { warn "sysopen failed: $!\n"; bye };
61sysseek(BIG, 1_000_000, SEEK_SET);
62syswrite(BIG, "big");
63close(BIG);
64
65my @s;
66
67@s = stat("big");
68
69print "# @s\n";
70
2ef4205b 71my $BLOCKSIZE = $s[11] || 512;
5cec1e3b 72
ea2b5ef6
JH
73unless (@s == 13 &&
74 $s[7] == 1_000_003 &&
ea2b5ef6 75 defined $s[12] &&
5cec1e3b 76 $BLOCKSIZE * $s[12] < 1_000_003) {
ea2b5ef6
JH
77 print "1..0\n# no sparse files?\n";
78 bye();
79}
80
81# By now we better be sure that we do have sparse files:
82# if we are not, the following will hog 5 gigabytes of disk. Ooops.
83
eed7fde4
JH
84$ENV{LC_ALL} = "C";
85
cc4466b7 86sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
ea2b5ef6
JH
87 do { warn "sysopen failed: $!\n"; bye };
88sysseek(BIG, 5_000_000_000, SEEK_SET);
eed7fde4 89
fcbfa962 90# The syswrite will fail if there are are filesize limitations (process or fs).
eed7fde4
JH
91my $syswrite = syswrite(BIG, "big") == 3;
92my $close = close BIG if $syswrite;
93unless($syswrite && $close) {
94 unless ($syswrite) {
95 print "# syswrite failed: $!\n"
96 } else {
97 print "# close failed: $!\n"
98 }
b948423f
JH
99 if ($! =~/too large/i) {
100 print "1..0\n# writing past 2GB failed: process limits?\n";
101 } elsif ($! =~ /quota/i) {
102 print "1..0\n# filesystem quota limits?\n";
fcbfa962 103 }
56d29690 104 explain();
eed7fde4 105 bye();
fcbfa962 106}
ea2b5ef6
JH
107
108@s = stat("big");
109
110print "# @s\n";
111
05f8a9f5 112sub fail () {
64215065 113 print "not ";
05f8a9f5
JH
114 $fail++;
115}
116
77166d51 117print "1..17\n";
fcbfa962
JH
118
119my $fail = 0;
120
64215065 121fail unless $s[7] == 5_000_000_003; # exercizes pp_stat
ea2b5ef6
JH
122print "ok 1\n";
123
64215065 124fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize
ea2b5ef6
JH
125print "ok 2\n";
126
77166d51
JH
127fail unless -e "big";
128print "ok 3\n";
129
130fail unless -f "big";
131print "ok 4\n";
132
ea2b5ef6
JH
133sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
134
77166d51
JH
135fail unless sysseek(BIG, 4_500_000_000, SEEK_SET) == 4_500_000_000;
136print "ok 5\n";
ea2b5ef6 137
05f8a9f5 138fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
77166d51 139print "ok 6\n";
ea2b5ef6 140
77166d51
JH
141fail unless sysseek(BIG, 1, SEEK_CUR) == 4_500_000_001;
142print "ok 7\n";
ea2b5ef6 143
05f8a9f5 144fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_001;
77166d51 145print "ok 8\n";
ea2b5ef6 146
77166d51
JH
147fail unless sysseek(BIG, -1, SEEK_CUR) == 4_500_000_000;
148print "ok 9\n";
ea2b5ef6 149
05f8a9f5 150fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
77166d51 151print "ok 10\n";
ea2b5ef6 152
77166d51
JH
153fail unless sysseek(BIG, -3, SEEK_END) == 5_000_000_000;
154print "ok 11\n";
ea2b5ef6 155
05f8a9f5 156fail unless sysseek(BIG, 0, SEEK_CUR) == 5_000_000_000;
77166d51 157print "ok 12\n";
ea2b5ef6
JH
158
159my $big;
160
05f8a9f5 161fail unless sysread(BIG, $big, 3) == 3;
77166d51 162print "ok 13\n";
ea2b5ef6 163
05f8a9f5 164fail unless $big eq "big";
77166d51
JH
165print "ok 14\n";
166
167# 705_032_704 = (I32)5_000_000_000
168fail unless seek(BIG, 705_032_704, $SEEK_SET);
169print "ok 15\n";
170
171my $zero;
172
173fail unless read(BIG, $zero, 3) == 3;
174print "ok 16\n";
175
176fail unless $zero eq "\0\0\0";
177print "ok 17\n";
ea2b5ef6 178
fcbfa962 179explain if $fail;
05f8a9f5 180
77166d51 181bye(); # does the necessary cleanup
e9a694fc 182
ea2b5ef6 183# eof