dist/Tie-File/t/07_rv_splice.t

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