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