Commit | Line | Data |
---|---|---|
0b28bc9a AMS |
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 |