30_defer.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#
# Check ->defer and ->flush methods
#
# This is the old version, which you used in the past when
# there was a defer buffer separate from the read cache.
# There isn't any longer.
#
use POSIX 'SEEK_SET';
my $file = "tf$$.txt";
my $data = "rec0$:rec1$:rec2$:";
my ($o, $n);
print "1..79\n";
my $N = 1;
print "ok $N\n"; $N++;
binmode F;
print F $data;
close F;
print $o ? "ok $N\n" : "not ok $N\n";
$N++;
# (3-6) Deferred storage
$o->defer;
$a[3] = "rec3";
$a[4] = "rec4";
# (7-8) Flush
$o->flush;
# (9-12) Deferred writing disabled?
$a[3] = "rec9";
$a[4] = "rec8";
# (13-18) Now let's try two batches of records
$#a = 2;
$o->defer;
$a[0] = "record0";
$a[2] = "record2";
$o->flush;
# (19-22) Deferred writing past the end of the file
$o->defer;
$a[4] = "record4";
$o->flush;
# (23-26) Now two long batches
$o->defer;
for (0..2, 4..6) {
$a[$_] = "r$_";
}
$o->flush;
# (27-30) Now let's make sure that discarded writes are really discarded
# We have a 2Mib buffer here, so we can be sure that we aren't accidentally
# filling it up
$o->defer;
for (0, 3, 7) {
$a[$_] = "discarded$_";
}
$o->discard;
################################################################
#
# Now we're going to test the results of a small memory limit
#
#
binmode F;
print F $data;
close F;
# Limit cache+buffer size to 47 bytes
my $MAX = 47;
# -- that's enough space for 5 records, but not 6, on both \n and \r\n systems
my $BUF = 20;
# -- that's enough space for 2 records, but not 3, on both \n and \r\n systems
print $o ? "ok $N\n" : "not ok $N\n";
$N++;
# (31-32) Fill up the read cache
my @z;
@z = @a;
# the cache now contains records 3,4,5,6,7.
{});
# (33-44) See if overloading the defer starts by flushing the read cache
# and then flushes out the defer
$o->defer;
$a[0] = "recordA"; # That should flush record 3 from the cache
{0 => "recordA$:"});
$a[1] = "recordB"; # That should flush record 4 from the cache
{0 => "recordA$:",
1 => "recordB$:"});
$a[2] = "recordC"; # That should flush the whole darn defer
# This shouldn't change the cache contents
{}); # URRRP
$a[3] = "recordD"; # even though we flushed, deferring is STILL ENABLED
{3 => "recordD$:"});
# Check readcache-deferbuffer interactions
# (45-47) This should remove outdated data from the read cache
$a[5] = "recordE";
{3 => "recordD$:", 5 => "recordE$:"});
# (48-51) This should read back out of the defer buffer
# without adding anything to the read cache
my $z;
$z = $a[5];
{3 => "recordD$:", 5 => "recordE$:"});
# (52-55) This should repopulate the read cache with a new record
$z = $a[0];
{3 => "recordD$:", 5 => "recordE$:"});
# (56-59) This should flush the LRU record from the read cache
$z = $a[4];
{3 => "recordD$:", 5 => "recordE$:"});
# (60-63) This should FLUSH the deferred buffer
{});
# (64-66) We should STILL be in deferred writing mode
$a[5] = "recordX";
{5 => "recordX$:"});
# Fill up the defer buffer again
$a[4] = "recordP";
# (67-69) This should OVERWRITE the existing deferred record
# and NOT flush the buffer
$a[5] = "recordQ";
{5 => "recordQ$:", 4 => "recordP$:"});
# (70-72) Discard should just dump the whole deferbuffer
$o->discard;
{});
# (73-75) NOW we are out of deferred writing mode
$a[0] = "recordF";
{});
# (76-79) Last call--untying the array should flush the deferbuffer
$o->defer;
$a[0] = "flushed";
{0 => "flushed$:" });
undef $o;
untie @a;
# (79) We can't use check_contents any more, because the object is dead
binmode F;
{ local $/ ; $z = <F> }
close F;
print "ok $N\n";
} else {
}
$N++;
################################################################
sub check_caches {
# my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
# print $integrity ? "ok $N\n" : "not ok $N\n";
# $N++;
my $good = 1;
# Copy the contents of the cache into a regular hash
my %cache;
}
$N++;
}
sub hash_equal {
my $good = 1;
my %b_seen;
$good = 0;
$b_seen{$k} = 1;
$good = 0;
} else {
$b_seen{$k} = 1;
}
}
$good = 0;
}
}
}
sub check_contents {
my $x = shift;
$N++;
my $a;
{ local $/; $a = <FH> }
print "ok $N\n";
} else {
}
$N++;
}
sub ctrlfix {
local $_ = shift;
s/\n/\\n/g;
s/\r/\\r/g;
$_;
}
END {
undef $o;
}