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