# Copyright (c) 2003, 2004, 2005 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..31\n"; }
END {print "not ok 1\n" unless $loaded;}
$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;
my $TEST_COUNT;
$TEST_COUNT = 2;
my $dbinit = 1;
my $gnz_home = File::Spec->catdir("t", "gnz_home");
my $gnz_restore = File::Spec->catdir("t", "restore");
#rmtree($gnz_home, 1, 1);
#mkpath($gnz_home, 1, 0755);
{
my $fb =
Genezzo::TestSetup::CreateOrRestoreDB(
gnz_home => $gnz_home,
restore_dir => $gnz_restore);
unless (defined($fb))
{
not_ok ("could not create database");
exit 1;
}
ok();
$dbinit = 0;
}
{
my $fb = Genezzo::GenDBI->new(exe => $0,
gnz_home => $gnz_home,
dbinit => $dbinit);
unless (defined($fb))
{
not_ok ("could not find database");
exit 1;
}
ok();
$dbinit = 0;
if ($fb->Parseall("startup"))
{
ok();
}
else
{
not_ok ("could not startup");
}
for my $ii (2..10)
{
if ($fb->Parseall("addfile filesize=32K"))
{
ok();
}
else
{
not_ok ("could not addfile $ii");
}
}
if ($fb->Parseall("addfile filesize=10M"))
{
ok();
}
else
{
not_ok ("could not addfile");
}
if ($fb->Parseall("ct test1 col1=c col2=c col3=c col4=c"))
{
ok();
}
else
{
not_ok ("could not create table");
}
if ($fb->Parseall("i test1 a b c d e f g h i j k l"))
{
ok();
}
else
{
not_ok ("could not insert");
}
if ($fb->Parseall('insert into test1 values (\'a1\', \'b1\', \'c1\', \'d1\', \'e1\', \'f1\', \'g1\', \'h1\')'))
{
ok();
}
else
{
not_ok ("could not insert");
}
my $dictobj = $fb->{dictobj};
my $tstable = $dictobj->DictTableGetTable (tname => "test1");
my $tv = tied(%{$tstable});
greet $tstable;
# greet $tstable, $tv;
greet "colcnt is ", $tv->HCount();
my @plist;
my @glist = qw( alphabravo delta_echo golf_hotel lima__mike );
for my $jj (@glist)
{
my $vv = $jj x 200; # make 2k bytes each
push @plist, $vv;
}
# XXX XXX: Note that direct manipulation of the hash lets you insert
# more columns than specified in the create table statement
my (@foo, $k1, $rowv1, @rowv);
for my $ii (1..3)
{
greet "push $ii";
@foo = $tv->HSuck (value =>\@plist);
$k1 = $foo[0];
# greet keys(%{$tstable});
# greet $tstable, @foo;
$rowv1 = $tstable->{$k1}; # fetch the big row
@rowv = @{$rowv1};
if (scalar(@rowv) == scalar(@plist))
{
ok();
}
else
{
not_ok( "count mismatch - push $ii");
}
for my $i (0..(scalar(@plist)-1))
{
unless ($rowv[$i] eq $plist[$i])
{
not_ok( "$i : " . $rowv[$i] . " vs " . $plist[$i] . " - push $ii");
last;
}
}
ok();
}
# greet $tstable->{$k1};
my @pl2 = qw(a1a b2b c3c d4d);
$tstable->{$k1} = \@pl2;
# greet $tstable->{$k1};
$rowv1 = $tstable->{$k1}; # fetch the big row
@rowv = @{$rowv1};
if (scalar(@rowv) == scalar(@pl2))
{
ok();
}
else
{
not_ok( "count mismatch 2");
}
for my $i (0..(scalar(@pl2)-1))
{
unless ($rowv[$i] eq $pl2[$i])
{
not_ok( "$i : " . $rowv[$i] . " vs " . $pl2[$i]);
last;
}
}
ok();
# _storesplit($tv, $k1, \@pl2);
$k1 = $tv->HPush (\@plist);
$rowv1 = $tstable->{$k1}; # fetch the big row
@rowv = @{$rowv1};
if (scalar(@rowv) == scalar(@plist))
{
ok();
}
else
{
not_ok( "count mismatch 3");
}
for my $i (0..(scalar(@plist)-1))
{
unless ($rowv[$i] eq $plist[$i])
{
not_ok( "$i : " . $rowv[$i] . " vs " . $plist[$i]);
last;
}
}
ok();
@pl2 = qw(aaa bbb ccc ddd);
$k1 = $tv->HPush (\@pl2);
$tstable->{$k1} = \@plist;
# greet $tv->STORE($k1, \@plist);
$rowv1 = $tstable->{$k1}; # fetch the big row
# greet $rowv1;
@rowv = @{$rowv1};
if (scalar(@rowv) == scalar(@plist))
{
ok();
}
else
{
not_ok( "count mismatch 4");
}
for my $i (0..(scalar(@plist)-1))
{
unless ($rowv[$i] eq $plist[$i])
{
not_ok( "$i : " . $rowv[$i] . " vs " . $plist[$i]);
last;
}
}
ok();
# $fb->Parseall("dump files");
if ($fb->Parseall("commit"))
{
ok();
}
else
{
not_ok ("could not commit");
}
if ($fb->Parseall("shutdown"))
{
ok();
}
else
{
not_ok ("could not shutdown");
}
}
# XXX XXX: obsolete - now part of RSTab
sub _storesplit
{
my ($self, $place, $value) = @_;
# greet $self;
my @fetcha = $self->_fetch2($place); # HPHRowBlk method
return undef
unless ( (scalar(@fetcha) > 1)
&& defined($fetcha[0])
&& defined($fetcha[1])
&& Genezzo::Block::RDBlock::_isheadrow($fetcha[1]));
my @rowpiece = UnPackRow($fetcha[0]); # first row piece
# Note: just return if row was not split. Avoid the extra push in
# the while loop
return ($self->STORE($place, $value))
if (Genezzo::Block::RDBlock::_istailrow($fetcha[1]));
my @packa;
my @rowpa;
my @techa;
my @placa;
push @placa, $place;
my $gotFrag = 0;
my @outarr;
# Fetch the remaining row pieces, and re-assemble the row. If the
# piece isn't the tail (end) of the row, the last column is a
# "next pointer", a pointer to the next piece, with a flag which
# indicates whether the last column (the real last column, not the
# aforementioned next pointer) was split.
L_rowpiece:
while (1)
{
my $foo;
$foo = [];
push @{$foo}, @rowpiece;
push @packa, $fetcha[0];
push @rowpa, $foo;
push @techa, [length($fetcha[0]), scalar(@{$foo}), $gotFrag] ;
if ($gotFrag)
{ # column was fragmented - merge the next column piece
my $h1 = shift @rowpiece;
$outarr[-1] .= $h1; # append remainder to end of last column
}
# append next set of columns to existing row
push @outarr, @rowpiece;
last L_rowpiece # done when last piece of row is fetched
if (Genezzo::Block::RDBlock::_istailrow($fetcha[1]));
my $nextp = pop @outarr; # last column was pointer to next piece,
# so remove it from output
# check next pointer to see if column was fragmented (split)
my ($frag, $pieceplace) = split(':', $nextp);
# XXX XXX: clean this up - centralize knowledge of frag flag somewhere
$gotFrag = (defined($frag)) && ($frag =~ m/F/);
# get the next piece
@fetcha = $self->_fetch2($pieceplace);
unless ( (scalar(@fetcha) > 1)
&& defined($fetcha[0])
&& defined($fetcha[1])
)
{ # ERROR: remainder of row not found
if (scalar(@outarr))
{
my $tname = $self->{tablename};
whisper "table $tname: malformed row $place at $pieceplace";
# carp "table $tname: malformed row $place at $pieceplace"
# if warnings::enabled();
}
return undef;
}
push @placa, $pieceplace;
@rowpiece = UnPackRow($fetcha[0]);
} # end while l_rowpiece
# greet @packa, @rowpa, @techa;
greet @rowpa, @techa, @placa;
my @sukk = $self->HSuck (value => $value, headless => 1);
my @fakerow;
push @fakerow, ""; # blank col1
push @fakerow, "F:".$sukk[0];
my $sstat = $self->_realStore($place, \@fakerow, 1);
# clear the tail flag
$fetcha[1] &= ~($Genezzo::Block::RDBlock::RowStats{tail});
my @estat = $self->_exists2($place, $fetcha[1]); # HPHRowBlk method
shift @placa;
for my $pl1 (@placa)
{
whisper "delete $pl1";
$self->DELETE($pl1);
}
return ($sstat);
}
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++;
}