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