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