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