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