Commit | Line | Data |
b5aed31e |
1 | #!/usr/bin/perl |
2 | # |
3 | # Check SPLICE function's return value |
4 | # (04_splice.t checks its effect on the file) |
5 | # |
6 | |
0b28bc9a |
7 | |
b5aed31e |
8 | my $file = "tf$$.txt"; |
b3fe5a4c |
9 | $: = Tie::File::_default_recsep(); |
10 | my $data = "rec0$:rec1$:rec2$:"; |
b5aed31e |
11 | |
bf919750 |
12 | print "1..56\n"; |
b5aed31e |
13 | |
14 | my $N = 1; |
15 | use Tie::File; |
16 | print "ok $N\n"; $N++; # partial credit just for showing up |
17 | |
7b6b3db1 |
18 | init_file($data); |
19 | |
0b28bc9a |
20 | my $o = tie @a, 'Tie::File', $file, autochomp => 0; |
b5aed31e |
21 | print $o ? "ok $N\n" : "not ok $N\n"; |
22 | $N++; |
23 | |
24 | my $n; |
25 | |
26 | # (3-12) splicing at the beginning |
b5aed31e |
27 | @r = splice(@a, 0, 0, "rec4"); |
28 | check_result(); |
29 | @r = splice(@a, 0, 1, "rec5"); # same length |
30 | check_result("rec4"); |
31 | @r = splice(@a, 0, 1, "record5"); # longer |
32 | check_result("rec5"); |
33 | |
34 | @r = splice(@a, 0, 1, "r5"); # shorter |
35 | check_result("record5"); |
36 | @r = splice(@a, 0, 1); # removal |
37 | check_result("r5"); |
38 | @r = splice(@a, 0, 0); # no-op |
39 | check_result(); |
40 | @r = splice(@a, 0, 0, 'r7', 'rec8'); # insert more than one |
41 | check_result(); |
42 | @r = splice(@a, 0, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
43 | check_result('r7', 'rec8'); |
44 | |
45 | @r = splice(@a, 0, 3, 'record9', 'rec10'); # delete more than insert |
46 | check_result('rec7', 'record8', 'rec9'); |
47 | @r = splice(@a, 0, 2); # delete more than one |
48 | check_result('record9', 'rec10'); |
49 | |
50 | |
51 | # (13-22) splicing in the middle |
52 | @r = splice(@a, 1, 0, "rec4"); |
53 | check_result(); |
54 | @r = splice(@a, 1, 1, "rec5"); # same length |
55 | check_result('rec4'); |
56 | @r = splice(@a, 1, 1, "record5"); # longer |
57 | check_result('rec5'); |
58 | |
59 | @r = splice(@a, 1, 1, "r5"); # shorter |
60 | check_result("record5"); |
61 | @r = splice(@a, 1, 1); # removal |
62 | check_result("r5"); |
63 | @r = splice(@a, 1, 0); # no-op |
64 | check_result(); |
65 | @r = splice(@a, 1, 0, 'r7', 'rec8'); # insert more than one |
66 | check_result(); |
67 | @r = splice(@a, 1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
68 | check_result('r7', 'rec8'); |
69 | |
70 | @r = splice(@a, 1, 3, 'record9', 'rec10'); # delete more than insert |
71 | check_result('rec7', 'record8', 'rec9'); |
72 | @r = splice(@a, 1, 2); # delete more than one |
73 | check_result('record9','rec10'); |
74 | |
75 | # (23-32) splicing at the end |
76 | @r = splice(@a, 3, 0, "rec4"); |
77 | check_result(); |
78 | @r = splice(@a, 3, 1, "rec5"); # same length |
79 | check_result('rec4'); |
80 | @r = splice(@a, 3, 1, "record5"); # longer |
81 | check_result('rec5'); |
82 | |
83 | @r = splice(@a, 3, 1, "r5"); # shorter |
84 | check_result('record5'); |
85 | @r = splice(@a, 3, 1); # removal |
86 | check_result('r5'); |
87 | @r = splice(@a, 3, 0); # no-op |
88 | check_result(); |
89 | @r = splice(@a, 3, 0, 'r7', 'rec8'); # insert more than one |
90 | check_result(); |
91 | @r = splice(@a, 3, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
92 | check_result('r7', 'rec8'); |
93 | |
94 | @r = splice(@a, 3, 3, 'record9', 'rec10'); # delete more than insert |
95 | check_result('rec7', 'record8', 'rec9'); |
96 | @r = splice(@a, 3, 2); # delete more than one |
97 | check_result('record9', 'rec10'); |
98 | |
99 | # (33-42) splicing with negative subscript |
100 | @r = splice(@a, -1, 0, "rec4"); |
101 | check_result(); |
102 | @r = splice(@a, -1, 1, "rec5"); # same length |
103 | check_result('rec2'); |
104 | @r = splice(@a, -1, 1, "record5"); # longer |
105 | check_result("rec5"); |
106 | |
107 | @r = splice(@a, -1, 1, "r5"); # shorter |
108 | check_result("record5"); |
109 | @r = splice(@a, -1, 1); # removal |
110 | check_result("r5"); |
111 | @r = splice(@a, -1, 0); # no-op |
112 | check_result(); |
113 | @r = splice(@a, -1, 0, 'r7', 'rec8'); # insert more than one |
114 | check_result(); |
115 | @r = splice(@a, -1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete |
116 | check_result('rec4'); |
117 | |
118 | @r = splice(@a, -3, 3, 'record9', 'rec10'); # delete more than insert |
119 | check_result('rec7', 'record8', 'rec9'); |
120 | @r = splice(@a, -4, 3); # delete more than one |
121 | check_result('r7', 'rec8', 'record9'); |
122 | |
123 | # (43) scrub it all out |
124 | @r = splice(@a, 0, 3); |
125 | check_result('rec0', 'rec1', 'rec10'); |
126 | |
127 | # (44) put some back in |
128 | @r = splice(@a, 0, 0, "rec0", "rec1"); |
129 | check_result(); |
130 | |
131 | # (45) what if we remove too many records? |
132 | @r = splice(@a, 0, 17); |
133 | check_result('rec0', 'rec1'); |
134 | |
51efdd02 |
135 | # (46-48) Now check the scalar context return |
136 | splice(@a, 0, 0, qw(I like pie)); |
137 | my $r; |
138 | $r = splice(@a, 0, 0); |
0b28bc9a |
139 | print !defined($r) ? "ok $N\n" : "not ok $N \# return should have been undef, was <$r>\n"; |
51efdd02 |
140 | $N++; |
141 | |
142 | $r = splice(@a, 2, 1); |
0b28bc9a |
143 | print $r eq "pie$:" ? "ok $N\n" : "not ok $N \# return should have been 'pie\\n', was <$r>\n"; |
51efdd02 |
144 | $N++; |
145 | |
146 | $r = splice(@a, 0, 2); |
0b28bc9a |
147 | print $r eq "like$:" ? "ok $N\n" : "not ok $N \# return should have been 'like\\n', was <$r>\n"; |
51efdd02 |
148 | $N++; |
149 | |
7b6b3db1 |
150 | # (49-50) Test default arguments |
151 | splice @a, 0, 0, (0..11); |
152 | @r = splice @a, 4; |
153 | check_result(4..11); |
154 | @r = splice @a; |
155 | check_result(0..3); |
51efdd02 |
156 | |
bf919750 |
157 | # (51-56) splice with negative length was treated wrong |
158 | # 20020402 Reported by Juerd Waalboer |
159 | @a = (0..8) ; |
160 | @r = splice @a, 0, -3; |
161 | check_result(0..5); |
162 | @a = (0..8) ; |
163 | @r = splice @a, 1, -3; |
164 | check_result(1..5); |
165 | @a = (0..8) ; |
166 | @r = splice @a, 7, -3; |
167 | check_result(); |
168 | @a = (0..2) ; |
169 | @r = splice @a, 0, -3; |
170 | check_result(); |
171 | @a = (0..2) ; |
172 | @r = splice @a, 1, -3; |
173 | check_result(); |
174 | @a = (0..2) ; |
175 | @r = splice @a, 7, -3; |
176 | check_result(); |
177 | |
b5aed31e |
178 | sub init_file { |
179 | my $data = shift; |
180 | open F, "> $file" or die $!; |
1768807e |
181 | binmode F; |
b5aed31e |
182 | print F $data; |
183 | close F; |
184 | } |
185 | |
186 | # actual results are in @r. |
187 | # expected results are in @_ |
188 | sub check_result { |
189 | my @x = @_; |
b3fe5a4c |
190 | s/$:$// for @r; |
b5aed31e |
191 | my $good = 1; |
192 | $good = 0 unless @r == @x; |
193 | for my $i (0 .. $#r) { |
194 | $good = 0 unless $r[$i] eq $x[$i]; |
195 | } |
196 | print $good ? "ok $N\n" : "not ok $N \# was (@r); should be (@x)\n"; |
197 | $N++; |
198 | } |
199 | |
200 | END { |
7b6b3db1 |
201 | undef $o; |
202 | untie @a; |
b5aed31e |
203 | 1 while unlink $file; |
204 | } |
205 | |