mldbm.t

嵌入式数据库Berkeley DB-4.5.20源代码

#!/usr/bin/perl -w

use strict ;

BEGIN 
{
    if ($] < 5.005) {
	print "1..0 # Skip: this is Perl $], skipping test\n" ;
	exit 0 ;
    }

    eval { require Data::Dumper ; };
    if ($@) {
	print "1..0 # Skip: Data::Dumper is not installed on this system.\n";
	exit 0 ;
    }
    {
        local ($^W) = 0 ;
        if ($Data::Dumper::VERSION < 2.08) {
            print "1..0 # Skip: Data::Dumper 2.08 or better required (found $Data::Dumper::VERSION).\n";
        exit 0 ;
    }
    }
    eval { require MLDBM ; };
    if ($@) {
	print "1..0 # Skip: MLDBM is not installed on this system.\n";
	exit 0 ;
    }
}

use lib 't' ;
use util ;

print "1..12\n";

{
    package BTREE ;
    
    use BerkeleyDB ;
    use MLDBM qw(BerkeleyDB::Btree) ; 
    use Data::Dumper;
    
    my $filename = "";
    my $lex = new LexFile $filename;
    
    $MLDBM::UseDB = "BerkeleyDB::Btree" ;
    my %o ;
    my $db = tie %o, 'MLDBM', -Filename => $filename,
    		     -Flags    => DB_CREATE
    		or die $!;
    ::ok 1, $db ;
    ::ok 2, $db->type() == DB_BTREE ;
    
    my $c = [\'c'];
    my $b = {};
    my $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];
    @o{qw(a b c)} = ($a, $b, $c);
    $o{d} = "{once upon a time}";
    $o{e} = 1024;
    $o{f} = 1024.1024;
    
    my $struct = [@o{qw(a b c)}];
    ::ok 3, ::_compare([$a, $b, $c], $struct);
    ::ok 4, $o{d} eq "{once upon a time}" ;
    ::ok 5, $o{e} == 1024 ;
    ::ok 6, $o{f} eq 1024.1024 ;
    
}

{

    package HASH ;

    use BerkeleyDB ;
    use MLDBM qw(BerkeleyDB::Hash) ; 
    use Data::Dumper;

    my $filename = "";
    my $lex = new LexFile $filename;

    unlink $filename ;
    $MLDBM::UseDB = "BerkeleyDB::Hash" ;
    my %o ;
    my $db = tie %o, 'MLDBM', -Filename => $filename,
		         -Flags    => DB_CREATE
		    or die $!;
    ::ok 7, $db ;
    ::ok 8, $db->type() == DB_HASH ;


    my $c = [\'c'];
    my $b = {};
    my $a = [1, $b, $c];
    $b->{a} = $a;
    $b->{b} = $a->[1];
    $b->{c} = $a->[2];
    @o{qw(a b c)} = ($a, $b, $c);
    $o{d} = "{once upon a time}";
    $o{e} = 1024;
    $o{f} = 1024.1024;

    my $struct = [@o{qw(a b c)}];
    ::ok 9, ::_compare([$a, $b, $c], $struct);
    ::ok 10, $o{d} eq "{once upon a time}" ;
    ::ok 11, $o{e} == 1024 ;
    ::ok 12, $o{f} eq 1024.1024 ;

}