# Copyright (c) 2003, 2004 Jeffrey I Cohen. All rights reserved.
#
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..484\n"; }
END {print "not ok 1\n" unless $loaded;}
use Genezzo::BufCa::BufCa;
use Genezzo::BufCa::BufCaElt;
use Genezzo::BufCa::BCFile;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
use strict;
#use warnings;
no warnings; # NOTE: turn on warnings to see error messages from BufCa
my $TEST_COUNT;
$TEST_COUNT = 2;
{
my $bce = Genezzo::BufCa::BufCaElt->new(blocksize => 10)
or
not_ok( "Couldn't create new BufCaElt" );
ok();
my $ref = $bce->{bigbuf};
if ($bce->_dirty())
{
not_ok("should be clean");
}
else
{
ok();
}
$$ref = "foo";
if ($$ref eq "foo")
{ ok();}
else
{
not_ok("should be foo");
}
if ($bce->_dirty())
{
ok();
}
else
{
not_ok("should be dirty");
}
if ($bce->_dirty(0))
{
not_ok("should be clean");
}
else
{
ok();
}
$$ref = "baz";
if ($$ref eq "baz")
{ ok();}
else
{
not_ok("should be baz");
}
if ($bce->_dirty())
{
ok();
}
else
{
not_ok("should be dirty");
}
}
{
# print "start bufca test\n";
my $bc = Genezzo::BufCa::BufCa->new(blocksize => 1, numblocks => 0);
if (defined($bc))
{
not_ok("numblocks too small");
}
else
{
ok();
}
$bc = Genezzo::BufCa::BufCa->new(blocksize => 0, numblocks => 1);
if (defined($bc))
{
not_ok("blocksize too small");
}
else
{
ok();
}
$bc = Genezzo::BufCa::BufCa->new(blocksize => "aa", numblocks => 1);
if (defined($bc))
{
not_ok("bad blocksize");
}
else
{
ok();
}
$bc = Genezzo::BufCa::BufCa->new(blocksize => 1, numblocks => "aa");
if (defined($bc))
{
not_ok("bad numblocks");
}
else
{
ok();
}
# print "end bufca test\n";
}
{
my $bc = Genezzo::BufCa::BufCa->new(blocksize => 10, numblocks => 2)
or
not_ok( "Couldn't create new bc" );
ok();
my $bceref = $bc->ReadBlock(blocknum => 1)
or
not_ok( "Couldn't get BufCaElt" );
ok();
my $bce = $$bceref;
{
my $ref = $bce->{bigbuf};
if ($bce->_dirty())
{
not_ok("should be clean");
}
else
{
ok();
}
$$ref = "foo";
if ($$ref eq "foo")
{ ok();}
else
{
not_ok("should be foo");
}
if ($bce->_dirty())
{
ok();
}
else
{
not_ok("should be dirty");
}
if ($bce->_dirty(0))
{
not_ok("should be clean");
}
else
{
ok();
}
$$ref = "baz";
if ($$ref eq "baz")
{ ok();}
else
{
not_ok("should be baz");
}
if ($bce->_dirty())
{
ok();
}
else
{
not_ok("should be dirty");
}
}
$bceref = $bc->ReadBlock(blocknum => 0)
or
not_ok( "Couldn't get BufCaElt" );
ok();
$bce = $$bceref;
{
my $ref = $bce->{bigbuf};
if ($bce->_dirty())
{
not_ok("should be clean");
}
else
{
ok();
}
$$ref = "foo";
if ($$ref eq "foo")
{ ok();}
else
{
not_ok("should be foo");
}
if ($bce->_dirty())
{
ok();
}
else
{
not_ok("should be dirty");
}
if ($bce->_dirty(0))
{
not_ok("should be clean");
}
else
{
ok();
}
$$ref = "baz";
if ($$ref eq "baz")
{ ok();}
else
{
not_ok("should be baz");
}
if ($bce->_dirty())
{
ok();
}
else
{
not_ok("should be dirty");
}
}
$bceref = $bc->ReadBlock(blocknum => 4);
if (defined($bceref))
{
not_ok("no such block");
}
else { ok(); }
}
{
my $tvar = 1; # gets reset in destroy callback
{ # start foo scope
my $foo;
{
my $baz = tie $foo, "Genezzo::BufCa::PinScalar"
or
not_ok("no pinscalar");
ok();
#my $funky = sub {print "howdy! - I am destroyed\n"};
my $funky = sub {
my ($package, $filename, $line) = caller(1);
# print "creator: $package, $filename, $line - unpin \n";
$tvar = 2;
# print "$tvar \n";
};
# register the funky callback
$baz->_DestroyCB($funky);
if ($tvar == 1)
{ ok();}
else
{
not_ok("should still be 1");
}
}
} # end foo scope
# just fiddle a bit to let garbage collection take place
my $tempo = 1;
$tempo = 2;
# end fiddling
# tvar got reset when foo was garbage collected
if ($tvar == 2)
{ ok();}
else
{
not_ok("should be 2");
}
}
{
my $totnumblocks = 50;
my $bc = Genezzo::BufCa::BufCa->new(blocksize => 10,
numblocks => $totnumblocks)
or
not_ok( "Couldn't create new bc" );
ok();
for my $i (0..($totnumblocks - 1))
{
my $bceref = $bc->ReadBlock(blocknum => $i)
or
not_ok( "Couldn't get BufCaElt" );
ok();
my $bce = $$bceref;
{
my $ref = $bce->{bigbuf};
if ($bce->_dirty())
{
not_ok("should be clean");
}
else
{
ok();
}
$$ref = "foo block $i";
if ($$ref eq "foo block $i")
{ ok();}
else
{
not_ok("should be foo block $i");
}
if ($bce->_dirty())
{
ok();
}
else
{
not_ok("should be dirty");
}
}
}
for my $i (0..($totnumblocks - 1))
{
my $bceref = $bc->ReadBlock(blocknum => $i)
or
not_ok( "Couldn't get BufCaElt" );
ok();
my $bce = $$bceref;
{
my $ref = $bce->{bigbuf};
if ($$ref eq "foo block $i")
{ ok();}
else
{
not_ok("should be foo block $i");
}
if ($bce->_dirty())
{
ok();
}
else
{
not_ok("should be dirty");
}
}
}
}
{
my $totnumblocks = 50;
my $bc = Genezzo::BufCa::BufCa->new(blocksize => 10,
numblocks => $totnumblocks)
or
not_ok( "Couldn't create new bc" );
ok();
my (@bce_arr, @bnum_arr);
my $i = 0;
L_f1:
while (1)
{
# print "start loop $i\n";
my $outi = $bc->GetFree();
last L_f1 unless (scalar(@{ $outi }));
my $bceref = pop (@{$outi});
my $blocknum = pop (@{$outi});
my $bce = $$bceref;
push @bnum_arr, $blocknum;
push @bce_arr, $bceref;
my $ref = $bce->{bigbuf};
$$ref = "block $blocknum";
$i++;
}
# print "$i \n";
if ($i == $totnumblocks)
{
ok();
}
else
{
not_ok("should have $totnumblocks blocks");
}
for my $jcnt (0..($i - 1))
{
# print "$jcnt \n";
my $blocknum = $bnum_arr[$jcnt];
my $bceref = $bce_arr[$jcnt];
my $bce = $$bceref;
{
my $ref = $bce->{bigbuf};
if ($$ref eq "block $blocknum")
{ ok();}
else
{
not_ok("ref doesnt match");
}
# print $$ref, "\n";
# print $bce->_dirty(), "\n";
if ($bce->_dirty())
{
ok();
}
else
{
not_ok("should be dirty");
}
}
}
@bce_arr = ();
}
sub ok
{
print "ok $TEST_COUNT\n";
$TEST_COUNT++;
}
sub not_ok
{
my ( $message ) = @_;
print "not ok $TEST_COUNT # $message\n";
$TEST_COUNT++;
}
sub skip
{
my ( $message ) = @_;
print "ok $TEST_COUNT # skipped: $message\n";
$TEST_COUNT++;
}