This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[REPATCH 5.005_61] Re: perldiag.pod omissions
[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)
2d4389e4
JH
33# tests are skipped or fail, it may mean either that your process is not
34# allowed to write large files or that the file system you are running
35# the tests on doesn't support large files, or both. You may also need
36# to reconfigure your kernel. (This is all very system-dependent.)
fcbfa962
JH
37#
38# Perl may still be able to support large files, once you have
2d4389e4 39# such a process and such a (file) system.
fcbfa962
JH
40#
41EOM
42}
43
05f8a9f5 44# Known have-nots.
ea2b5ef6
JH
45if ($^O eq 'win32' || $^O eq 'vms') {
46 print "1..0\n# no sparse files\n";
47 bye();
48}
49
05f8a9f5
JH
50# Then try to deduce whether we have sparse files.
51
ea2b5ef6 52# We'll start off by creating a one megabyte file which has
05f8a9f5
JH
53# only three "true" bytes. If we have sparseness, we should
54# consume less blocks than one megabyte (assuming nobody has
55# one megabyte blocks...)
ea2b5ef6 56
cc4466b7 57sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
ea2b5ef6
JH
58 do { warn "sysopen failed: $!\n"; bye };
59sysseek(BIG, 1_000_000, SEEK_SET);
60syswrite(BIG, "big");
61close(BIG);
62
63my @s;
64
65@s = stat("big");
66
67print "# @s\n";
68
5cec1e3b
JH
69my $BLOCKSIZE = 512; # is this really correct everywhere?
70
ea2b5ef6
JH
71unless (@s == 13 &&
72 $s[7] == 1_000_003 &&
ea2b5ef6 73 defined $s[12] &&
5cec1e3b 74 $BLOCKSIZE * $s[12] < 1_000_003) {
ea2b5ef6
JH
75 print "1..0\n# no sparse files?\n";
76 bye();
77}
78
79# By now we better be sure that we do have sparse files:
80# if we are not, the following will hog 5 gigabytes of disk. Ooops.
81
cc4466b7 82sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
ea2b5ef6
JH
83 do { warn "sysopen failed: $!\n"; bye };
84sysseek(BIG, 5_000_000_000, SEEK_SET);
fcbfa962
JH
85# The syswrite will fail if there are are filesize limitations (process or fs).
86unless(syswrite(BIG, "big") == 3) {
87 $ENV{LC_ALL} = "C";
88 if ($! =~/File too large/) {
89 print "1..0\n# writing past 2GB failed\n";
90 explain();
91 bye();
92 }
93}
ea2b5ef6
JH
94close BIG;
95
96@s = stat("big");
97
98print "# @s\n";
99
05f8a9f5 100sub fail () {
64215065 101 print "not ";
05f8a9f5
JH
102 $fail++;
103}
104
fcbfa962
JH
105print "1..8\n";
106
107my $fail = 0;
108
64215065 109fail unless $s[7] == 5_000_000_003; # exercizes pp_stat
ea2b5ef6
JH
110print "ok 1\n";
111
64215065 112fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize
ea2b5ef6
JH
113print "ok 2\n";
114
115sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
116
117sysseek(BIG, 4_500_000_000, SEEK_SET);
118
05f8a9f5 119fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
ea2b5ef6
JH
120print "ok 3\n";
121
122sysseek(BIG, 1, SEEK_CUR);
123
05f8a9f5 124fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_001;
ea2b5ef6
JH
125print "ok 4\n";
126
127sysseek(BIG, -1, SEEK_CUR);
128
05f8a9f5 129fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
ea2b5ef6
JH
130print "ok 5\n";
131
132sysseek(BIG, -3, SEEK_END);
133
05f8a9f5 134fail unless sysseek(BIG, 0, SEEK_CUR) == 5_000_000_000;
ea2b5ef6
JH
135print "ok 6\n";
136
137my $big;
138
05f8a9f5 139fail unless sysread(BIG, $big, 3) == 3;
ea2b5ef6
JH
140print "ok 7\n";
141
05f8a9f5 142fail unless $big eq "big";
ea2b5ef6
JH
143print "ok 8\n";
144
fcbfa962 145explain if $fail;
05f8a9f5 146
e9a694fc
JH
147bye();
148
ea2b5ef6 149# eof