lib/Tie/File/t/19_cache.t

   1 #!/usr/bin/perl
   2 #
   3 # Tests for various caching errors
   4 #
   5
   6 $|=1;
   7 my $file = "tf$$.txt";
   8 $: = Tie::File::_default_recsep();
   9 my $data = join $:, "rec0" .. "rec9", "";
  10 my $V = $ENV{INTEGRITY};        # Verbose integrity checking?
  11
  12 print "1..55\n";
  13
  14 my $N = 1;
  15 use Tie::File;
  16 print "ok $N\n"; $N++;
  17
  18 open F, "> $file" or die $!;
  19 binmode F;
  20 print F $data;
  21 close F;
  22
  23 my $o = tie @a, 'Tie::File', $file;
  24 print $o ? "ok $N\n" : "not ok $N\n";
  25 $N++;
  26
  27 # (3) Through 0.18, this 'splice' call would corrupt the cache.
  28 my @z = @a;                     # force cache to contain all ten records
  29 splice @a, 0, 0, "x";
  30 print $o->_check_integrity($file, $V) ? "ok $N\n" : "not ok $N\n";
  31 $N++;
  32
  33 # Here we redo *all* the splice tests, with populate()
  34 # calls before each one, to make sure that splice() does not botch the cache.
  35
  36 # (4-14) splicing at the beginning
  37 check();
  38 splice(@a, 0, 0, "rec4");
  39 check();
  40 splice(@a, 0, 1, "rec5");       # same length
  41 check();
  42 splice(@a, 0, 1, "record5");    # longer
  43 check();
  44 splice(@a, 0, 1, "r5");         # shorter
  45 check();
  46 splice(@a, 0, 1);               # removal
  47 check();
  48 splice(@a, 0, 0);               # no-op
  49 check();
  50
  51 splice(@a, 0, 0, 'r7', 'rec8'); # insert more than one
  52 check();
  53 splice(@a, 0, 2, 'rec7', 'record8', 'rec9'); # insert more than delete
  54 check();
  55 splice(@a, 0, 3, 'record9', 'rec10'); # delete more than insert
  56 check();
  57 splice(@a, 0, 2);               # delete more than one
  58 check();
  59
  60
  61 # (15-24) splicing in the middle
  62 splice(@a, 1, 0, "rec4");
  63 check();
  64 splice(@a, 1, 1, "rec5");       # same length
  65 check();
  66 splice(@a, 1, 1, "record5");    # longer
  67 check();
  68 splice(@a, 1, 1, "r5");         # shorter
  69 check();
  70 splice(@a, 1, 1);               # removal
  71 check();
  72 splice(@a, 1, 0);               # no-op
  73 check();
  74
  75 splice(@a, 1, 0, 'r7', 'rec8'); # insert more than one
  76 check();
  77 splice(@a, 1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete
  78 check();
  79 splice(@a, 1, 3, 'record9', 'rec10'); # delete more than insert
  80 check();
  81 splice(@a, 1, 2);               # delete more than one
  82 check();
  83
  84 # (25-34) splicing at the end
  85 splice(@a, 3, 0, "rec4");
  86 check();
  87 splice(@a, 3, 1, "rec5");       # same length
  88 check();
  89 splice(@a, 3, 1, "record5");    # longer
  90 check();
  91 splice(@a, 3, 1, "r5");         # shorter
  92 check();
  93 splice(@a, 3, 1);               # removal
  94 check();
  95 splice(@a, 3, 0);               # no-op
  96 check();
  97
  98 splice(@a, 3, 0, 'r7', 'rec8'); # insert more than one
  99 check();
 100 splice(@a, 3, 2, 'rec7', 'record8', 'rec9'); # insert more than delete
 101 check();
 102 splice(@a, 3, 3, 'record9', 'rec10'); # delete more than insert
 103 check();
 104 splice(@a, 3, 2);               # delete more than one
 105 check();
 106
 107 # (35-44) splicing with negative subscript
 108 splice(@a, -1, 0, "rec4");
 109 check();
 110 splice(@a, -1, 1, "rec5");       # same length
 111 check();
 112 splice(@a, -1, 1, "record5");    # longer
 113 check();
 114 splice(@a, -1, 1, "r5");         # shorter
 115 check();
 116 splice(@a, -1, 1);               # removal
 117 check();
 118 splice(@a, -1, 0);               # no-op
 119 check();
 120
 121 splice(@a, -1, 0, 'r7', 'rec8'); # insert more than one
 122 check();
 123 splice(@a, -1, 2, 'rec7', 'record8', 'rec9'); # insert more than delete
 124 check();
 125 splice(@a, -3, 3, 'record9', 'rec10'); # delete more than insert
 126 check();
 127 splice(@a, -4, 3);               # delete more than one
 128 check();
 129
 130 # (45) scrub it all out
 131 splice(@a, 0, 3);
 132 check();
 133
 134 # (46) put some back in
 135 splice(@a, 0, 0, "rec0", "rec1");
 136 check();
 137
 138 # (47) what if we remove too many records?
 139 splice(@a, 0, 17);
 140 check();
 141
 142 # (48-49) In the past, splicing past the end was not correctly detected
 143 # (1.14)
 144 splice(@a, 89, 3);
 145 check();
 146 splice(@a, @a, 3);
 147 check();
 148
 149 # (50-51) Also we did not emulate splice's freaky behavior when inserting
 150 # past the end of the array (1.14)
 151 splice(@a, 89, 0, "I", "like", "pie");
 152 check();
 153 splice(@a, 89, 0, "pie pie pie");
 154 check();
 155
 156 # (52-54) Test default arguments
 157 splice @a, 0, 0, (0..11);
 158 check();
 159 splice @a, 4;
 160 check();
 161 splice @a;
 162 check();
 163
 164 # (55) This was broken on 20030507 when you moved the cache management
 165 # stuff out of _oadjust back into _splice without also putting it back
 166 # into _store.
 167 @a = (0..11);
 168 check();
 169
 170 sub init_file {
 171   my $data = shift;
 172   open F, "> $file" or die $!;
 173   binmode F;
 174   print F $data;
 175   close F;
 176 }
 177
 178 sub check {
 179   my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
 180   print $integrity ? "ok $N\n" : "not ok $N\n";
 181   $N++;
 182   repopulate();
 183 }
 184
 185
 186 sub ctrlfix {
 187   for (@_) {
 188     s/\n/\\n/g;
 189     s/\r/\\r/g;
 190   }
 191 }
 192
 193 sub repopulate {
 194   $o->{cache}->empty;
 195   my @z = @a;                   # refill the cache with correct data
 196 }
 197
 198 END {
 199   undef $o;
 200   untie @a;
 201   1 while unlink $file;
 202 }
 203
 204
 205