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