This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
detypo #5411 continues: Sun grep doesn't have -e.
[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 {
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
17sub bye {
18 close(BIG);
19 unlink "big";
20 exit(0);
21}
22
fcbfa962 23sub explain {
2d4389e4 24 print <<EOM;
fcbfa962
JH
25#
26# If the lfs (large file support: large meaning larger than two gigabytes)
eed7fde4
JH
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
JH
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
JH
36#
37EOM
38}
39
e0a10278
JH
40print "# checking whether we have sparse files...\n";
41
05f8a9f5 42# Known have-nots.
ea2b5ef6 43if ($^O eq 'win32' || $^O eq 'vms') {
e0a10278 44 print "1..0\n# no sparse files (because this is $^O) \n";
ea2b5ef6
JH
45 bye();
46}
47
b18f8161
JH
48# Known haves that have problems running this test
49# (for example because they do not support sparse files, like UNICOS)
50if ($^O eq 'unicos') {
e0a10278 51 print "1..0\n# large files known to work but unable to test them here ($^O)\n";
b18f8161
JH
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
JH
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 62sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
ea2b5ef6
JH
63 do { warn "sysopen failed: $!\n"; bye };
64sysseek(BIG, 1_000_000, SEEK_SET);
65syswrite(BIG, "big");
66close(BIG);
67
68my @s;
69
70@s = stat("big");
71
72print "# @s\n";
73
2ef4205b 74my $BLOCKSIZE = $s[11] || 512;
5cec1e3b 75
ea2b5ef6
JH
76unless (@s == 13 &&
77 $s[7] == 1_000_003 &&
ea2b5ef6 78 defined $s[12] &&
5cec1e3b 79 $BLOCKSIZE * $s[12] < 1_000_003) {
ea2b5ef6
JH
80 print "1..0\n# no sparse files?\n";
81 bye();
82}
83
e0a10278
JH
84print "# we seem to have sparse files...\n";
85
ea2b5ef6
JH
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
JH
89$ENV{LC_ALL} = "C";
90
cc4466b7 91sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
e0a10278
JH
92 do { warn "sysopen 'big' failed: $!\n"; bye };
93my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
94unless (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
JH
102my $syswrite = syswrite(BIG, "big");
103print "# syswrite failed: $! (syswrite returned ",
104 defined $syswrite ? $syswrite : 'undef', ")\n"
105 unless defined $syswrite && $syswrite == 3;
106my $close = close BIG;
107print "# close failed: $!\n" unless $close;
eed7fde4 108unless($syswrite && $close) {
b948423f
JH
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
JH
117
118@s = stat("big");
119
120print "# @s\n";
121
ae178db1
JH
122unless ($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 128sub fail () {
64215065 129 print "not ";
05f8a9f5
JH
130 $fail++;
131}
132
77166d51 133print "1..17\n";
fcbfa962
JH
134
135my $fail = 0;
136
64215065 137fail unless $s[7] == 5_000_000_003; # exercizes pp_stat
ea2b5ef6
JH
138print "ok 1\n";
139
64215065 140fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize
ea2b5ef6
JH
141print "ok 2\n";
142
77166d51
JH
143fail unless -e "big";
144print "ok 3\n";
145
146fail unless -f "big";
147print "ok 4\n";
148
ea2b5ef6
JH
149sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
150
77166d51
JH
151fail unless sysseek(BIG, 4_500_000_000, SEEK_SET) == 4_500_000_000;
152print "ok 5\n";
ea2b5ef6 153
05f8a9f5 154fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
77166d51 155print "ok 6\n";
ea2b5ef6 156
77166d51
JH
157fail unless sysseek(BIG, 1, SEEK_CUR) == 4_500_000_001;
158print "ok 7\n";
ea2b5ef6 159
05f8a9f5 160fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_001;
77166d51 161print "ok 8\n";
ea2b5ef6 162
77166d51
JH
163fail unless sysseek(BIG, -1, SEEK_CUR) == 4_500_000_000;
164print "ok 9\n";
ea2b5ef6 165
05f8a9f5 166fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
77166d51 167print "ok 10\n";
ea2b5ef6 168
77166d51
JH
169fail unless sysseek(BIG, -3, SEEK_END) == 5_000_000_000;
170print "ok 11\n";
ea2b5ef6 171
05f8a9f5 172fail unless sysseek(BIG, 0, SEEK_CUR) == 5_000_000_000;
77166d51 173print "ok 12\n";
ea2b5ef6
JH
174
175my $big;
176
05f8a9f5 177fail unless sysread(BIG, $big, 3) == 3;
77166d51 178print "ok 13\n";
ea2b5ef6 179
05f8a9f5 180fail unless $big eq "big";
77166d51
JH
181print "ok 14\n";
182
183# 705_032_704 = (I32)5_000_000_000
184fail unless seek(BIG, 705_032_704, $SEEK_SET);
185print "ok 15\n";
186
187my $zero;
188
189fail unless read(BIG, $zero, 3) == 3;
190print "ok 16\n";
191
192fail unless $zero eq "\0\0\0";
193print "ok 17\n";
ea2b5ef6 194
fcbfa962 195explain if $fail;
05f8a9f5 196
77166d51 197bye(); # does the necessary cleanup
e9a694fc 198
290be4b1
JH
199END {
200 unlink "big"; # be paranoid about leaving 5 gig files lying around
201}
202
ea2b5ef6 203# eof