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