Commit | Line | Data |
ea2b5ef6 |
1 | # NOTE: this file tests how large files (>2GB) work with perlio (stdio/sfio). |
2 | # sysopen(), sysseek(), syswrite(), sysread() are tested in t/lib/syslfs.t. |
3 | # If you modify/add tests here, remember to update also t/lib/syslfs.t. |
4 | |
817e2dcb |
5 | BEGIN { |
05f8a9f5 |
6 | # Don't bother if there are no quads. |
ea2b5ef6 |
7 | eval { my $q = pack "q", 0 }; |
817e2dcb |
8 | if ($@) { |
9 | print "1..0\n# no 64-bit types\n"; |
ea2b5ef6 |
10 | bye(); |
817e2dcb |
11 | } |
ea2b5ef6 |
12 | chdir 't' if -d 't'; |
13 | unshift @INC, '../lib'; |
9f8fdb7d |
14 | # Don't bother if there are no quad offsets. |
15 | require Config; import Config; |
16 | if ($Config{lseeksize} < 8) { |
17 | print "1..0\n# no 64-bit offsets\n"; |
18 | bye(); |
19 | } |
817e2dcb |
20 | } |
21 | |
6da84e39 |
22 | sub bye { |
23 | close(BIG); |
24 | unlink "big"; |
25 | exit(0); |
26 | } |
27 | |
05f8a9f5 |
28 | # Known have-nots. |
817e2dcb |
29 | if ($^O eq 'win32' || $^O eq 'vms') { |
30 | print "1..0\n# no sparse files\n"; |
6da84e39 |
31 | bye(); |
32 | } |
33 | |
05f8a9f5 |
34 | # Then try to deduce whether we have sparse files. |
35 | |
ea2b5ef6 |
36 | my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2); |
6da84e39 |
37 | |
ea2b5ef6 |
38 | # We'll start off by creating a one megabyte file which has |
05f8a9f5 |
39 | # only three "true" bytes. If we have sparseness, we should |
40 | # consume less blocks than one megabyte (assuming nobody has |
41 | # one megabyte blocks...) |
817e2dcb |
42 | |
ea2b5ef6 |
43 | open(BIG, ">big") or do { warn "open failed: $!\n"; bye }; |
6da84e39 |
44 | binmode BIG; |
ea2b5ef6 |
45 | seek(BIG, 1_000_000, $SEEK_SET); |
6da84e39 |
46 | print BIG "big"; |
817e2dcb |
47 | close(BIG); |
48 | |
49 | my @s; |
50 | |
51 | @s = stat("big"); |
52 | |
ea2b5ef6 |
53 | print "# @s\n"; |
54 | |
6da84e39 |
55 | unless (@s == 13 && |
ea2b5ef6 |
56 | $s[7] == 1_000_003 && |
6da84e39 |
57 | defined $s[11] && |
58 | defined $s[12] && |
ea2b5ef6 |
59 | $s[11] * $s[12] < 1000_003) { |
60 | print "1..0\n# no sparse files?\n"; |
6da84e39 |
61 | bye(); |
817e2dcb |
62 | } |
63 | |
64 | # By now we better be sure that we do have sparse files: |
65 | # if we are not, the following will hog 5 gigabytes of disk. Ooops. |
66 | |
67 | print "1..8\n"; |
68 | |
05f8a9f5 |
69 | my $fail = 0; |
70 | |
ea2b5ef6 |
71 | open(BIG, ">big") or do { warn "open failed: $!\n"; bye }; |
817e2dcb |
72 | binmode BIG; |
6da84e39 |
73 | seek(BIG, 5_000_000_000, $SEEK_SET); |
817e2dcb |
74 | print BIG "big"; |
75 | close BIG; |
76 | |
77 | @s = stat("big"); |
78 | |
ea2b5ef6 |
79 | print "# @s\n"; |
80 | |
05f8a9f5 |
81 | sub fail () { |
82 | print " not "; |
83 | $fail++; |
84 | } |
85 | |
86 | fail unless $s[7] == 5_000_000_003; |
817e2dcb |
87 | print "ok 1\n"; |
88 | |
05f8a9f5 |
89 | fail unless -s "big" == 5_000_000_003; |
817e2dcb |
90 | print "ok 2\n"; |
91 | |
ea2b5ef6 |
92 | open(BIG, "big") or do { warn "open failed: $!\n"; bye }; |
817e2dcb |
93 | binmode BIG; |
94 | |
6da84e39 |
95 | seek(BIG, 4_500_000_000, $SEEK_SET); |
817e2dcb |
96 | |
05f8a9f5 |
97 | fail unless tell(BIG) == 4_500_000_000; |
817e2dcb |
98 | print "ok 3\n"; |
99 | |
6da84e39 |
100 | seek(BIG, 1, $SEEK_CUR); |
817e2dcb |
101 | |
05f8a9f5 |
102 | fail unless tell(BIG) == 4_500_000_001; |
817e2dcb |
103 | print "ok 4\n"; |
104 | |
6da84e39 |
105 | seek(BIG, -1, $SEEK_CUR); |
817e2dcb |
106 | |
05f8a9f5 |
107 | fail unless tell(BIG) == 4_500_000_000; |
817e2dcb |
108 | print "ok 5\n"; |
109 | |
6da84e39 |
110 | seek(BIG, -3, $SEEK_END); |
817e2dcb |
111 | |
05f8a9f5 |
112 | fail unless tell(BIG) == 5_000_000_000; |
817e2dcb |
113 | print "ok 6\n"; |
114 | |
115 | my $big; |
116 | |
05f8a9f5 |
117 | fail unless read(BIG, $big, 3) == 3; |
817e2dcb |
118 | print "ok 7\n"; |
119 | |
05f8a9f5 |
120 | fail unless $big eq "big"; |
817e2dcb |
121 | print "ok 8\n"; |
122 | |
6da84e39 |
123 | bye(); |
817e2dcb |
124 | |
05f8a9f5 |
125 | if ($fail) { |
126 | print STDERR <<EOM; |
127 | # |
128 | # If the lfs (large file support) tests fail, it means that |
129 | # the *file system* you are running the tests on doesn't support |
130 | # large files (files larger than two gigabytes). Perl may still |
131 | # be able to support such files, once you have such a file system. |
132 | # |
133 | EOM |
134 | } |
135 | |
6da84e39 |
136 | # eof |