Commit | Line | Data |
b5aed31e |
1 | #!/usr/bin/perl |
2 | # |
3 | # Check SPLICE function's effect on the file |
4 | # (07_rv_splice.t checks its return value) |
5 | # |
6 | # Each call to 'check_contents' actually performs two tests. |
7 | # First, it calls the tied object's own 'check_integrity' method, |
8 | # which makes sure that the contents of the read cache and offset tables |
9 | # accurately reflect the contents of the file. |
10 | # Then, it checks the actual contents of the file against the expected |
11 | # contents. |
12 | |
b5aed31e |
13 | my $file = "tf$$.txt"; |
14 | my $data = "rec0$/rec1$/rec2$/"; |
15 | |
7b6b3db1 |
16 | print "1..101\n"; |
17 | |
18 | init_file($data); |
b5aed31e |
19 | |
20 | my $N = 1; |
21 | use Tie::File; |
22 | print "ok $N\n"; $N++; # partial credit just for showing up |
23 | |
24 | my $o = tie @a, 'Tie::File', $file; |
25 | print $o ? "ok $N\n" : "not ok $N\n"; |
26 | $N++; |
27 | |
28 | my $n; |
29 | |
30 | # (3-22) splicing at the beginning |
b5aed31e |
31 | splice(@a, 0, 0, "rec4"); |
32 | check_contents("rec4$/$data"); |
33 | splice(@a, 0, 1, "rec5"); # same length |
34 | check_contents("rec5$/$data"); |
35 | splice(@a, 0, 1, "record5"); # longer |
36 | check_contents("record5$/$data"); |
37 | |
38 | splice(@a, 0, 1, "r5"); # shorter |
39 | check_contents("r5$/$data"); |
40 | splice(@a, 0, 1); # removal |
41 | check_contents("$data"); |
42 | splice(@a, 0, 0); # no-op |
43 | check_contents("$data"); |
44 | splice(@a, 0, 0, 'r7', 'rec8'); # insert more than one |
45 | check_contents("r7$/rec8$/$data"); |
46 | splice(@a, 0, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
47 | check_contents("rec7$/record8$/rec9$/$data"); |
48 | |
49 | splice(@a, 0, 3, 'record9', 'rec10'); # delete more than insert |
50 | check_contents("record9$/rec10$/$data"); |
51 | splice(@a, 0, 2); # delete more than one |
52 | check_contents("$data"); |
53 | |
54 | |
55 | # (23-42) splicing in the middle |
56 | splice(@a, 1, 0, "rec4"); |
57 | check_contents("rec0$/rec4$/rec1$/rec2$/"); |
58 | splice(@a, 1, 1, "rec5"); # same length |
59 | check_contents("rec0$/rec5$/rec1$/rec2$/"); |
60 | splice(@a, 1, 1, "record5"); # longer |
61 | check_contents("rec0$/record5$/rec1$/rec2$/"); |
62 | |
63 | splice(@a, 1, 1, "r5"); # shorter |
64 | check_contents("rec0$/r5$/rec1$/rec2$/"); |
65 | splice(@a, 1, 1); # removal |
66 | check_contents("$data"); |
67 | splice(@a, 1, 0); # no-op |
68 | check_contents("$data"); |
69 | splice(@a, 1, 0, 'r7', 'rec8'); # insert more than one |
70 | check_contents("rec0$/r7$/rec8$/rec1$/rec2$/"); |
71 | splice(@a, 1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
72 | check_contents("rec0$/rec7$/record8$/rec9$/rec1$/rec2$/"); |
73 | |
74 | splice(@a, 1, 3, 'record9', 'rec10'); # delete more than insert |
75 | check_contents("rec0$/record9$/rec10$/rec1$/rec2$/"); |
76 | splice(@a, 1, 2); # delete more than one |
77 | check_contents("$data"); |
78 | |
79 | # (43-62) splicing at the end |
80 | splice(@a, 3, 0, "rec4"); |
81 | check_contents("$ {data}rec4$/"); |
82 | splice(@a, 3, 1, "rec5"); # same length |
83 | check_contents("$ {data}rec5$/"); |
84 | splice(@a, 3, 1, "record5"); # longer |
85 | check_contents("$ {data}record5$/"); |
86 | |
87 | splice(@a, 3, 1, "r5"); # shorter |
88 | check_contents("$ {data}r5$/"); |
89 | splice(@a, 3, 1); # removal |
90 | check_contents("$data"); |
91 | splice(@a, 3, 0); # no-op |
92 | check_contents("$data"); |
93 | splice(@a, 3, 0, 'r7', 'rec8'); # insert more than one |
94 | check_contents("$ {data}r7$/rec8$/"); |
95 | splice(@a, 3, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
96 | check_contents("$ {data}rec7$/record8$/rec9$/"); |
97 | |
98 | splice(@a, 3, 3, 'record9', 'rec10'); # delete more than insert |
99 | check_contents("$ {data}record9$/rec10$/"); |
100 | splice(@a, 3, 2); # delete more than one |
101 | check_contents("$data"); |
102 | |
103 | # (63-82) splicing with negative subscript |
104 | splice(@a, -1, 0, "rec4"); |
105 | check_contents("rec0$/rec1$/rec4$/rec2$/"); |
106 | splice(@a, -1, 1, "rec5"); # same length |
107 | check_contents("rec0$/rec1$/rec4$/rec5$/"); |
108 | splice(@a, -1, 1, "record5"); # longer |
109 | check_contents("rec0$/rec1$/rec4$/record5$/"); |
110 | |
111 | splice(@a, -1, 1, "r5"); # shorter |
112 | check_contents("rec0$/rec1$/rec4$/r5$/"); |
113 | splice(@a, -1, 1); # removal |
114 | check_contents("rec0$/rec1$/rec4$/"); |
115 | splice(@a, -1, 0); # no-op |
116 | check_contents("rec0$/rec1$/rec4$/"); |
117 | splice(@a, -1, 0, 'r7', 'rec8'); # insert more than one |
118 | check_contents("rec0$/rec1$/r7$/rec8$/rec4$/"); |
119 | splice(@a, -1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
120 | check_contents("rec0$/rec1$/r7$/rec8$/rec7$/record8$/rec9$/"); |
121 | |
122 | splice(@a, -3, 3, 'record9', 'rec10'); # delete more than insert |
123 | check_contents("rec0$/rec1$/r7$/rec8$/record9$/rec10$/"); |
124 | splice(@a, -4, 3); # delete more than one |
125 | check_contents("rec0$/rec1$/rec10$/"); |
126 | |
127 | # (83-84) scrub it all out |
128 | splice(@a, 0, 3); |
129 | check_contents(""); |
130 | |
131 | # (85-86) put some back in |
132 | splice(@a, 0, 0, "rec0", "rec1"); |
133 | check_contents("rec0$/rec1$/"); |
134 | |
135 | # (87-88) what if we remove too many records? |
136 | splice(@a, 0, 17); |
137 | check_contents(""); |
138 | |
51efdd02 |
139 | # (89-92) In the past, splicing past the end was not correctly detected |
140 | # (1.14) |
141 | splice(@a, 89, 3); |
142 | check_contents(""); |
143 | splice(@a, @a, 3); |
144 | check_contents(""); |
145 | |
146 | # (93-96) Also we did not emulate splice's freaky behavior when inserting |
147 | # past the end of the array (1.14) |
148 | splice(@a, 89, 0, "I", "like", "pie"); |
149 | check_contents("I$/like$/pie$/"); |
150 | splice(@a, 89, 0, "pie pie pie"); |
151 | check_contents("I$/like$/pie$/pie pie pie$/"); |
152 | |
153 | # (97) Splicing with too large a negative number should be fatal |
154 | # This test ignored because it causes 5.6.1 and 5.7.2 to dump core |
155 | # NOT MY FAULT |
fa408a35 |
156 | if ($] < 5.006 || $] > 5.007003) { |
51efdd02 |
157 | eval { splice(@a, -7, 0) }; |
158 | print $@ =~ /^Modification of non-creatable array value attempted, subscript -7/ |
159 | ? "ok $N\n" : "not ok $N \# \$\@ was '$@'\n"; |
160 | } else { |
fa408a35 |
161 | print "ok $N \# skipped (5.6.0 through 5.7.3 dump core here.)\n"; |
51efdd02 |
162 | } |
163 | $N++; |
164 | |
7b6b3db1 |
165 | # (98-101) Test default arguments |
166 | splice @a, 0, 0, (0..11); |
167 | splice @a, 4; |
168 | check_contents("0$/1$/2$/3$/"); |
169 | splice @a; |
170 | check_contents(""); |
51efdd02 |
171 | |
172 | |
b5aed31e |
173 | sub init_file { |
174 | my $data = shift; |
175 | open F, "> $file" or die $!; |
1768807e |
176 | binmode F; |
b5aed31e |
177 | print F $data; |
178 | close F; |
179 | } |
180 | |
7b6b3db1 |
181 | use POSIX 'SEEK_SET'; |
b5aed31e |
182 | sub check_contents { |
183 | my $x = shift; |
b5aed31e |
184 | my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY}); |
7b6b3db1 |
185 | local *FH = $o->{fh}; |
186 | seek FH, 0, SEEK_SET; |
b5aed31e |
187 | print $integrity ? "ok $N\n" : "not ok $N\n"; |
188 | $N++; |
b5aed31e |
189 | my $a; |
190 | { local $/; $a = <FH> } |
7b6b3db1 |
191 | $a = "" unless defined $a; |
192 | if ($a eq $x) { |
193 | print "ok $N\n"; |
194 | } else { |
195 | s{$/}{\\n}g for $a, $x; |
196 | print "not ok $N\n# expected <$x>, got <$a>\n"; |
197 | } |
b5aed31e |
198 | $N++; |
199 | } |
200 | |
201 | END { |
7b6b3db1 |
202 | undef $o; |
203 | untie @a; |
b5aed31e |
204 | 1 while unlink $file; |
205 | } |
206 | |