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