25_gen_nocache.t revision 1
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj#!/usr/bin/perl
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj#
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj# Regular read-write tests with caching disabled
e5dcf7beb7c949f9234713d5818b581ec3825443Robert Johnston# (Same as 01_gen.t)
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj#
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjmy $file = "tf$$.txt";
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjprint "1..68\n";
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjmy $N = 1;
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjuse Tie::File;
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjprint "ok $N\n"; $N++;
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjmy $o = tie @a, 'Tie::File', $file, autochomp => 0, autodefer => 0, memory => 0;
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjprint $o ? "ok $N\n" : "not ok $N\n";
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$N++;
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$: = $o->{recsep};
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj# 3-5 create
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[0] = 'rec0';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("rec0");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj# 6-11 append
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[1] = 'rec1';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("rec0", "rec1");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[2] = 'rec2';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("rec0", "rec1", "rec2");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
e3d60c9bd991a9826cbfa63b10595d44e123b9c4Adrian Frost# 12-20 same-length alterations
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[0] = 'new0';
2eeaed14a5e2ed9bd811643ad5bffc3510ca0310robjcheck_contents("new0", "rec1", "rec2");
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj$a[1] = 'new1';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("new0", "new1", "rec2");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[2] = 'new2';
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnstoncheck_contents("new0", "new1", "new2");
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnston
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnston# 21-35 lengthening alterations
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnston$a[0] = 'long0';
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnstoncheck_contents("long0", "new1", "new2");
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnston$a[1] = 'long1';
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnstoncheck_contents("long0", "long1", "new2");
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnston$a[2] = 'long2';
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnstoncheck_contents("long0", "long1", "long2");
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnston$a[1] = 'longer1';
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnstoncheck_contents("long0", "longer1", "long2");
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnston$a[0] = 'longer0';
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnstoncheck_contents("longer0", "longer1", "long2");
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnston
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnston# 36-50 shortening alterations, including truncation
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnston$a[0] = 'short0';
cf327f5a61bfa78d5cf81410e439640e480f850bRobert Johnstoncheck_contents("short0", "longer1", "long2");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[1] = 'short1';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("short0", "short1", "long2");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[2] = 'short2';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("short0", "short1", "short2");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[1] = 'sh1';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("short0", "sh1", "short2");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[0] = 'sh0';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("sh0", "sh1", "short2");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj# (51-56) file with holes
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[4] = 'rec4';
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnstoncheck_contents("sh0", "sh1", "short2", "", "rec4");
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnston$a[3] = 'rec3';
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnstoncheck_contents("sh0", "sh1", "short2", "rec3", "rec4");
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnston# (57-59) zero out file
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston@a = ();
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnstoncheck_contents();
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnston# (60-62) insert into the middle of an empty file
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnston$a[3] = "rec3";
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnstoncheck_contents("", "", "", "rec3");
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnston
7fcedef2cb0c5f9b2168d8c757cf243facdec1e6Robert Johnston# (63-68) 20020326 You thought there would be a bug in STORE where if
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj# a cached record was false, STORE wouldn't see it at all. But you
2eeaed14a5e2ed9bd811643ad5bffc3510ca0310robj# forgot that records always come back from the cache with the record
2eeaed14a5e2ed9bd811643ad5bffc3510ca0310robj# separator attached, so they are unlikely to be false. The only
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj# really weird case is when the cached record is empty and the record
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj# separator is "0". Test that in 09_gen_rs.t.
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[1] = "0";
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("", "0", "", "rec3");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj$a[1] = "whoops";
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjcheck_contents("", "whoops", "", "rec3");
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjuse POSIX 'SEEK_SET';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robjsub check_contents {
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj my @c = @_;
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj my $x = join $:, @c, '';
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj local *FH = $o->{fh};
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj seek FH, 0, SEEK_SET;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj# my $open = open FH, "< $file";
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj my $a;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj { local $/; $a = <FH> }
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston $a = "" unless defined $a;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj if ($a eq $x) {
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston print "ok $N\n";
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston } else {
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston ctrlfix($a, $x);
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj print "not ok $N\n# expected <$x>, got <$a>\n";
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj }
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj $N++;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj # now check FETCH:
4557a2a1868181b517f5dfe61ba6eeba58edf4c0robj my $good = 1;
2eeaed14a5e2ed9bd811643ad5bffc3510ca0310robj my $msg;
2eeaed14a5e2ed9bd811643ad5bffc3510ca0310robj for (0.. $#c) {
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj my $aa = $a[$_];
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj unless ($aa eq "$c[$_]$:") {
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj $msg = "expected <$c[$_]$:>, got <$aa>";
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj ctrlfix($msg);
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj $good = 0;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj }
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj }
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj print $good ? "ok $N\n" : "not ok $N # $msg\n";
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj $N++;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj print $o->_check_integrity($file, $ENV{INTEGRITY})
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj ? "ok $N\n" : "not ok $N\n";
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj $N++;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj}
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robjsub ctrlfix {
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston for (@_) {
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj s/\n/\\n/g;
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston s/\r/\\r/g;
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston }
88045cff0aae4ed8823cd0989168e8f56927f83eRobert Johnston}
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robjEND {
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj undef $o;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj untie @a;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj 1 while unlink $file;
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj}
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj
825ba0f20a74fd9c5d0d1ce2c195da2cc88a7f77robj