Import BSDDB 4.7.25 (as of svn r89086)
This commit is contained in:
Zachary Ware
236
perl/BerkeleyDB/t/join.t
Normal file
236
perl/BerkeleyDB/t/join.t
Normal file
@@ -0,0 +1,236 @@
|
||||
#!./perl -w
|
||||
|
||||
# ID: %I%, %G%
|
||||
|
||||
use strict ;
|
||||
|
||||
use lib 't';
|
||||
use BerkeleyDB;
|
||||
use util ;
|
||||
|
||||
if ($BerkeleyDB::db_ver < 2.005002)
|
||||
{
|
||||
print "1..0 # Skip: join needs Berkeley DB 2.5.2 or later\n" ;
|
||||
exit 0 ;
|
||||
}
|
||||
|
||||
|
||||
print "1..42\n";
|
||||
|
||||
my $Dfile1 = "dbhash1.tmp";
|
||||
my $Dfile2 = "dbhash2.tmp";
|
||||
my $Dfile3 = "dbhash3.tmp";
|
||||
unlink $Dfile1, $Dfile2, $Dfile3 ;
|
||||
|
||||
umask(0) ;
|
||||
|
||||
{
|
||||
# error cases
|
||||
my $lex = new LexFile $Dfile1, $Dfile2, $Dfile3 ;
|
||||
my %hash1 ;
|
||||
my $value ;
|
||||
my $status ;
|
||||
my $cursor ;
|
||||
|
||||
ok 1, my $db1 = tie %hash1, 'BerkeleyDB::Hash',
|
||||
-Filename => $Dfile1,
|
||||
-Flags => DB_CREATE,
|
||||
-DupCompare => sub { $_[0] lt $_[1] },
|
||||
-Property => DB_DUP|DB_DUPSORT ;
|
||||
|
||||
# no cursors supplied
|
||||
eval '$cursor = $db1->db_join() ;' ;
|
||||
ok 2, $@ =~ /Usage: \$db->BerkeleyDB::db_join\Q([cursors], flags=0)/;
|
||||
|
||||
# empty list
|
||||
eval '$cursor = $db1->db_join([]) ;' ;
|
||||
ok 3, $@ =~ /db_join: No cursors in parameter list/;
|
||||
|
||||
# cursor list, isn not a []
|
||||
eval '$cursor = $db1->db_join({}) ;' ;
|
||||
ok 4, $@ =~ /db_join: first parameter is not an array reference/;
|
||||
|
||||
eval '$cursor = $db1->db_join(\1) ;' ;
|
||||
ok 5, $@ =~ /db_join: first parameter is not an array reference/;
|
||||
|
||||
my ($a, $b) = ("a", "b");
|
||||
$a = bless [], "fred";
|
||||
$b = bless [], "fred";
|
||||
eval '$cursor = $db1->db_join($a, $b) ;' ;
|
||||
ok 6, $@ =~ /db_join: first parameter is not an array reference/;
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
# test a 2-way & 3-way join
|
||||
|
||||
my $lex = new LexFile $Dfile1, $Dfile2, $Dfile3 ;
|
||||
my %hash1 ;
|
||||
my %hash2 ;
|
||||
my %hash3 ;
|
||||
my $value ;
|
||||
my $status ;
|
||||
|
||||
my $home = "./fred7" ;
|
||||
rmtree $home;
|
||||
ok 7, ! -d $home;
|
||||
ok 8, my $lexD = new LexDir($home);
|
||||
ok 9, my $env = new BerkeleyDB::Env -Home => $home, @StdErrFile,
|
||||
-Flags => DB_CREATE|DB_INIT_TXN
|
||||
|DB_INIT_MPOOL;
|
||||
#|DB_INIT_MPOOL| DB_INIT_LOCK;
|
||||
ok 10, my $txn = $env->txn_begin() ;
|
||||
ok 11, my $db1 = tie %hash1, 'BerkeleyDB::Hash',
|
||||
-Filename => $Dfile1,
|
||||
-Flags => DB_CREATE,
|
||||
-DupCompare => sub { $_[0] cmp $_[1] },
|
||||
-Property => DB_DUP|DB_DUPSORT,
|
||||
-Env => $env,
|
||||
-Txn => $txn ;
|
||||
;
|
||||
|
||||
ok 12, my $db2 = tie %hash2, 'BerkeleyDB::Hash',
|
||||
-Filename => $Dfile2,
|
||||
-Flags => DB_CREATE,
|
||||
-DupCompare => sub { $_[0] cmp $_[1] },
|
||||
-Property => DB_DUP|DB_DUPSORT,
|
||||
-Env => $env,
|
||||
-Txn => $txn ;
|
||||
|
||||
ok 13, my $db3 = tie %hash3, 'BerkeleyDB::Btree',
|
||||
-Filename => $Dfile3,
|
||||
-Flags => DB_CREATE,
|
||||
-DupCompare => sub { $_[0] cmp $_[1] },
|
||||
-Property => DB_DUP|DB_DUPSORT,
|
||||
-Env => $env,
|
||||
-Txn => $txn ;
|
||||
|
||||
|
||||
ok 14, addData($db1, qw( apple Convenience
|
||||
peach Shopway
|
||||
pear Farmer
|
||||
raspberry Shopway
|
||||
strawberry Shopway
|
||||
gooseberry Farmer
|
||||
blueberry Farmer
|
||||
));
|
||||
|
||||
ok 15, addData($db2, qw( red apple
|
||||
red raspberry
|
||||
red strawberry
|
||||
yellow peach
|
||||
yellow pear
|
||||
green gooseberry
|
||||
blue blueberry)) ;
|
||||
|
||||
ok 16, addData($db3, qw( expensive apple
|
||||
reasonable raspberry
|
||||
expensive strawberry
|
||||
reasonable peach
|
||||
reasonable pear
|
||||
expensive gooseberry
|
||||
reasonable blueberry)) ;
|
||||
|
||||
ok 17, my $cursor2 = $db2->db_cursor() ;
|
||||
my $k = "red" ;
|
||||
my $v = "" ;
|
||||
ok 18, $cursor2->c_get($k, $v, DB_SET) == 0 ;
|
||||
|
||||
# Two way Join
|
||||
ok 19, my $cursor1 = $db1->db_join([$cursor2]) ;
|
||||
|
||||
my %expected = qw( apple Convenience
|
||||
raspberry Shopway
|
||||
strawberry Shopway
|
||||
) ;
|
||||
|
||||
# sequence forwards
|
||||
while ($cursor1->c_get($k, $v) == 0) {
|
||||
delete $expected{$k}
|
||||
if defined $expected{$k} && $expected{$k} eq $v ;
|
||||
#print "[$k] [$v]\n" ;
|
||||
}
|
||||
ok 20, keys %expected == 0 ;
|
||||
ok 21, $cursor1->status() == DB_NOTFOUND ;
|
||||
|
||||
# Three way Join
|
||||
ok 22, $cursor2 = $db2->db_cursor() ;
|
||||
$k = "red" ;
|
||||
$v = "" ;
|
||||
ok 23, $cursor2->c_get($k, $v, DB_SET) == 0 ;
|
||||
|
||||
ok 24, my $cursor3 = $db3->db_cursor() ;
|
||||
$k = "expensive" ;
|
||||
$v = "" ;
|
||||
ok 25, $cursor3->c_get($k, $v, DB_SET) == 0 ;
|
||||
ok 26, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
|
||||
|
||||
%expected = qw( apple Convenience
|
||||
strawberry Shopway
|
||||
) ;
|
||||
|
||||
# sequence forwards
|
||||
while ($cursor1->c_get($k, $v) == 0) {
|
||||
delete $expected{$k}
|
||||
if defined $expected{$k} && $expected{$k} eq $v ;
|
||||
#print "[$k] [$v]\n" ;
|
||||
}
|
||||
ok 27, keys %expected == 0 ;
|
||||
ok 28, $cursor1->status() == DB_NOTFOUND ;
|
||||
|
||||
# test DB_JOIN_ITEM
|
||||
# #################
|
||||
ok 29, $cursor2 = $db2->db_cursor() ;
|
||||
$k = "red" ;
|
||||
$v = "" ;
|
||||
ok 30, $cursor2->c_get($k, $v, DB_SET) == 0 ;
|
||||
|
||||
ok 31, $cursor3 = $db3->db_cursor() ;
|
||||
$k = "expensive" ;
|
||||
$v = "" ;
|
||||
ok 32, $cursor3->c_get($k, $v, DB_SET) == 0 ;
|
||||
ok 33, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
|
||||
|
||||
%expected = qw( apple 1
|
||||
strawberry 1
|
||||
) ;
|
||||
|
||||
# sequence forwards
|
||||
$k = "" ;
|
||||
$v = "" ;
|
||||
while ($cursor1->c_get($k, $v, DB_JOIN_ITEM) == 0) {
|
||||
delete $expected{$k}
|
||||
if defined $expected{$k} ;
|
||||
#print "[$k]\n" ;
|
||||
}
|
||||
ok 34, keys %expected == 0 ;
|
||||
ok 35, $cursor1->status() == DB_NOTFOUND ;
|
||||
|
||||
ok 36, $cursor1->c_close() == 0 ;
|
||||
ok 37, $cursor2->c_close() == 0 ;
|
||||
ok 38, $cursor3->c_close() == 0 ;
|
||||
|
||||
ok 39, ($status = $txn->txn_commit()) == 0;
|
||||
|
||||
undef $txn ;
|
||||
|
||||
ok 40, my $cursor1a = $db1->db_cursor() ;
|
||||
eval { $cursor1 = $db1->db_join([$cursor1a]) };
|
||||
ok 41, $@ =~ /BerkeleyDB Aborting: attempted to do a self-join at/;
|
||||
eval { $cursor1 = $db1->db_join([$cursor1]) } ;
|
||||
ok 42, $@ =~ /BerkeleyDB Aborting: attempted to do a self-join at/;
|
||||
|
||||
undef $cursor1a;
|
||||
#undef $cursor1;
|
||||
#undef $cursor2;
|
||||
#undef $cursor3;
|
||||
undef $db1 ;
|
||||
undef $db2 ;
|
||||
undef $db3 ;
|
||||
undef $env ;
|
||||
untie %hash1 ;
|
||||
untie %hash2 ;
|
||||
untie %hash3 ;
|
||||
}
|
||||
|
||||
print "# at the end\n";
|
||||
Reference in New Issue
Block a user