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