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