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
7use strict;
8use warnings;
9
10my $file = "tf23-$$.txt";
11$: = Tie::File::_default_recsep();
12my $data = "rec0$:rec1$:rec2$:";
13
14print "1..50\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 => 1;
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', 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', 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
160sub init_file {
161  my $data = shift;
162  open F, '>', $file or die $!;
163  binmode F;
164  print F $data;
165  close F;
166}
167
168# actual results are in @r.
169# expected results are in @_
170sub check_result {
171  my @x = @_;
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