BEGIN { $| = 1;
print
"1..31\n"
; }
END {
print
"not ok 1\n"
unless
$loaded
;}
$loaded
= 1;
print
"ok 1\n"
;
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"
);
{
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
"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;
push
@plist
,
$vv
;
}
my
(
@foo
,
$k1
,
$rowv1
,
@rowv
);
for
my
$ii
(1..3)
{
greet
"push $ii"
;
@foo
=
$tv
->HSuck (
value
=>\
@plist
);
$k1
=
$foo
[0];
$rowv1
=
$tstable
->{
$k1
};
@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();
}
my
@pl2
=
qw(a1a b2b c3c d4d)
;
$tstable
->{
$k1
} = \
@pl2
;
$rowv1
=
$tstable
->{
$k1
};
@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();
$k1
=
$tv
->HPush (\
@plist
);
$rowv1
=
$tstable
->{
$k1
};
@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
;
$rowv1
=
$tstable
->{
$k1
};
@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();
if
(
$fb
->Parseall(
"commit"
))
{
ok();
}
else
{
not_ok (
"could not commit"
);
}
if
(
$fb
->Parseall(
"shutdown"
))
{
ok();
}
else
{
not_ok (
"could not shutdown"
);
}
}
sub
_storesplit
{
my
(
$self
,
$place
,
$value
) =
@_
;
my
@fetcha
=
$self
->_fetch2(
$place
);
return
undef
unless
( (
scalar
(
@fetcha
) > 1)
&&
defined
(
$fetcha
[0])
&&
defined
(
$fetcha
[1])
&& Genezzo::Block::RDBlock::_isheadrow(
$fetcha
[1]));
my
@rowpiece
= UnPackRow(
$fetcha
[0]);
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
;
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
)
{
my
$h1
=
shift
@rowpiece
;
$outarr
[-1] .=
$h1
;
}
push
@outarr
,
@rowpiece
;
last
L_rowpiece
if
(Genezzo::Block::RDBlock::_istailrow(
$fetcha
[1]));
my
$nextp
=
pop
@outarr
;
my
(
$frag
,
$pieceplace
) =
split
(
':'
,
$nextp
);
$gotFrag
= (
defined
(
$frag
)) && (
$frag
=~ m/F/);
@fetcha
=
$self
->_fetch2(
$pieceplace
);
unless
( (
scalar
(
@fetcha
) > 1)
&&
defined
(
$fetcha
[0])
&&
defined
(
$fetcha
[1])
)
{
if
(
scalar
(
@outarr
))
{
my
$tname
=
$self
->{tablename};
whisper
"table $tname: malformed row $place at $pieceplace"
;
}
return
undef
;
}
push
@placa
,
$pieceplace
;
@rowpiece
= UnPackRow(
$fetcha
[0]);
}
greet
@rowpa
,
@techa
,
@placa
;
my
@sukk
=
$self
->HSuck (
value
=>
$value
,
headless
=> 1);
my
@fakerow
;
push
@fakerow
,
""
;
push
@fakerow
,
"F:"
.
$sukk
[0];
my
$sstat
=
$self
->_realStore(
$place
, \
@fakerow
, 1);
$fetcha
[1] &= ~(
$Genezzo::Block::RDBlock::RowStats
{tail});
my
@estat
=
$self
->_exists2(
$place
,
$fetcha
[1]);
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
++;
}