lib/Tie/File/04_splice.t

   1 #!/usr/bin/perl
   2 #
   3 # Check SPLICE function's effect on the file
   4 # (07_rv_splice.t checks its return value)
   5 #
   6 # Each call to 'check_contents' actually performs two tests.
   7 # First, it calls the tied object's own 'check_integrity' method,
   8 # which makes sure that the contents of the read cache and offset tables
   9 # accurately reflect the contents of the file.
  10 # Then, it checks the actual contents of the file against the expected
  11 # contents.
  12
  13 use lib '/home/mjd/src/perl/Tie-File2/lib';
  14 my $file = "tf$$.txt";
  15 my $data = "rec0$/rec1$/rec2$/";
  16
  17 print "1..88\n";
  18
  19 my $N = 1;
  20 use Tie::File;
  21 print "ok $N\n"; $N++;  # partial credit just for showing up
  22
  23 my $o = tie @a, 'Tie::File', $file;
  24 print $o ? "ok $N\n" : "not ok $N\n";
  25 $N++;
  26
  27 my $n;
  28
  29 # (3-22) splicing at the beginning
  30 init_file($data);
  31
  32 splice(@a, 0, 0, "rec4");
  33 check_contents("rec4$/$data");
  34 splice(@a, 0, 1, "rec5");       # same length
  35 check_contents("rec5$/$data");
  36 splice(@a, 0, 1, "record5");    # longer
  37 check_contents("record5$/$data");
  38
  39 splice(@a, 0, 1, "r5");         # shorter
  40 check_contents("r5$/$data");
  41 splice(@a, 0, 1);               # removal
  42 check_contents("$data");
  43 splice(@a, 0, 0);               # no-op
  44 check_contents("$data");
  45 splice(@a, 0, 0, 'r7', 'rec8'); # insert more than one
  46 check_contents("r7$/rec8$/$data");
  47 splice(@a, 0, 2, 'rec7', 'record8', 'rec9'); # insert more than delete
  48 check_contents("rec7$/record8$/rec9$/$data");
  49
  50 splice(@a, 0, 3, 'record9', 'rec10'); # delete more than insert
  51 check_contents("record9$/rec10$/$data");
  52 splice(@a, 0, 2);               # delete more than one
  53 check_contents("$data");
  54
  55
  56 # (23-42) splicing in the middle
  57 splice(@a, 1, 0, "rec4");
  58 check_contents("rec0$/rec4$/rec1$/rec2$/");
  59 splice(@a, 1, 1, "rec5");       # same length
  60 check_contents("rec0$/rec5$/rec1$/rec2$/");
  61 splice(@a, 1, 1, "record5");    # longer
  62 check_contents("rec0$/record5$/rec1$/rec2$/");
  63
  64 splice(@a, 1, 1, "r5");         # shorter
  65 check_contents("rec0$/r5$/rec1$/rec2$/");
  66 splice(@a, 1, 1);               # removal
  67 check_contents("$data");
  68 splice(@a, 1, 0);               # no-op
  69 check_contents("$data");
  70 splice(@a, 1, 0, 'r7', 'rec8'); # insert more than one
  71 check_contents("rec0$/r7$/rec8$/rec1$/rec2$/");
  72 splice(@a, 1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete
  73 check_contents("rec0$/rec7$/record8$/rec9$/rec1$/rec2$/");
  74
  75 splice(@a, 1, 3, 'record9', 'rec10'); # delete more than insert
  76 check_contents("rec0$/record9$/rec10$/rec1$/rec2$/");
  77 splice(@a, 1, 2);               # delete more than one
  78 check_contents("$data");
  79
  80 # (43-62) splicing at the end
  81 splice(@a, 3, 0, "rec4");
  82 check_contents("$ {data}rec4$/");
  83 splice(@a, 3, 1, "rec5");       # same length
  84 check_contents("$ {data}rec5$/");
  85 splice(@a, 3, 1, "record5");    # longer
  86 check_contents("$ {data}record5$/");
  87
  88 splice(@a, 3, 1, "r5");         # shorter
  89 check_contents("$ {data}r5$/");
  90 splice(@a, 3, 1);               # removal
  91 check_contents("$data");
  92 splice(@a, 3, 0);               # no-op
  93 check_contents("$data");
  94 splice(@a, 3, 0, 'r7', 'rec8'); # insert more than one
  95 check_contents("$ {data}r7$/rec8$/");
  96 splice(@a, 3, 2, 'rec7', 'record8', 'rec9'); # insert more than delete
  97 check_contents("$ {data}rec7$/record8$/rec9$/");
  98
  99 splice(@a, 3, 3, 'record9', 'rec10'); # delete more than insert
 100 check_contents("$ {data}record9$/rec10$/");
 101 splice(@a, 3, 2);               # delete more than one
 102 check_contents("$data");
 103
 104 # (63-82) splicing with negative subscript
 105 splice(@a, -1, 0, "rec4");
 106 check_contents("rec0$/rec1$/rec4$/rec2$/");
 107 splice(@a, -1, 1, "rec5");       # same length
 108 check_contents("rec0$/rec1$/rec4$/rec5$/");
 109 splice(@a, -1, 1, "record5");    # longer
 110 check_contents("rec0$/rec1$/rec4$/record5$/");
 111
 112 splice(@a, -1, 1, "r5");         # shorter
 113 check_contents("rec0$/rec1$/rec4$/r5$/");
 114 splice(@a, -1, 1);               # removal
 115 check_contents("rec0$/rec1$/rec4$/");
 116 splice(@a, -1, 0);               # no-op
 117 check_contents("rec0$/rec1$/rec4$/");
 118 splice(@a, -1, 0, 'r7', 'rec8'); # insert more than one
 119 check_contents("rec0$/rec1$/r7$/rec8$/rec4$/");
 120 splice(@a, -1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete
 121 check_contents("rec0$/rec1$/r7$/rec8$/rec7$/record8$/rec9$/");
 122
 123 splice(@a, -3, 3, 'record9', 'rec10'); # delete more than insert
 124 check_contents("rec0$/rec1$/r7$/rec8$/record9$/rec10$/");
 125 splice(@a, -4, 3);               # delete more than one
 126 check_contents("rec0$/rec1$/rec10$/");
 127
 128 # (83-84) scrub it all out
 129 splice(@a, 0, 3);
 130 check_contents("");
 131
 132 # (85-86) put some back in
 133 splice(@a, 0, 0, "rec0", "rec1");
 134 check_contents("rec0$/rec1$/");
 135
 136 # (87-88) what if we remove too many records?
 137 splice(@a, 0, 17);
 138 check_contents("");
 139
 140 sub init_file {
 141   my $data = shift;
 142   open F, "> $file" or die $!;
 143   print F $data;
 144   close F;
 145 }
 146
 147 sub check_contents {
 148   my $x = shift;
 149   local *FH;
 150   my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
 151   print $integrity ? "ok $N\n" : "not ok $N\n";
 152   $N++;
 153   my $open = open FH, "< $file";
 154   my $a;
 155   { local $/; $a = <FH> }
 156   print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n");
 157   $N++;
 158 }
 159
 160 END {
 161   1 while unlink $file;
 162 }
 163