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