1#!/usr/bin/perl -w
2
3use strict ;
4
5BEGIN 
6{
7    if ($] < 5.005) {
8	print "1..0 # Skip: this is Perl $], skipping test\n" ;
9	exit 0 ;
10    }
11
12    eval { require Data::Dumper ; };
13    if ($@) {
14	print "1..0 # Skip: Data::Dumper is not installed on this system.\n";
15	exit 0 ;
16    }
17    {
18        local ($^W) = 0 ;
19        if ($Data::Dumper::VERSION < 2.08) {
20            print "1..0 # Skip: Data::Dumper 2.08 or better required (found $Data::Dumper::VERSION).\n";
21        exit 0 ;
22    }
23    }
24    eval { require MLDBM ; };
25    if ($@) {
26	print "1..0 # Skip: MLDBM is not installed on this system.\n";
27	exit 0 ;
28    }
29}
30
31use lib 't' ;
32use util ;
33
34print "1..12\n";
35
36{
37    package BTREE ;
38    
39    use BerkeleyDB ;
40    use MLDBM qw(BerkeleyDB::Btree) ; 
41    use Data::Dumper;
42    
43    my $filename = "";
44    my $lex = new LexFile $filename;
45    
46    $MLDBM::UseDB = "BerkeleyDB::Btree" ;
47    my %o ;
48    my $db = tie %o, 'MLDBM', -Filename => $filename,
49    		     -Flags    => DB_CREATE
50    		or die $!;
51    ::ok 1, $db ;
52    ::ok 2, $db->type() == DB_BTREE ;
53    
54    my $c = [\'c'];
55    my $b = {};
56    my $a = [1, $b, $c];
57    $b->{a} = $a;
58    $b->{b} = $a->[1];
59    $b->{c} = $a->[2];
60    @o{qw(a b c)} = ($a, $b, $c);
61    $o{d} = "{once upon a time}";
62    $o{e} = 1024;
63    $o{f} = 1024.1024;
64    
65    my $struct = [@o{qw(a b c)}];
66    ::ok 3, ::_compare([$a, $b, $c], $struct);
67    ::ok 4, $o{d} eq "{once upon a time}" ;
68    ::ok 5, $o{e} == 1024 ;
69    ::ok 6, $o{f} eq 1024.1024 ;
70    
71}
72
73{
74
75    package HASH ;
76
77    use BerkeleyDB ;
78    use MLDBM qw(BerkeleyDB::Hash) ; 
79    use Data::Dumper;
80
81    my $filename = "";
82    my $lex = new LexFile $filename;
83
84    unlink $filename ;
85    $MLDBM::UseDB = "BerkeleyDB::Hash" ;
86    my %o ;
87    my $db = tie %o, 'MLDBM', -Filename => $filename,
88		         -Flags    => DB_CREATE
89		    or die $!;
90    ::ok 7, $db ;
91    ::ok 8, $db->type() == DB_HASH ;
92
93
94    my $c = [\'c'];
95    my $b = {};
96    my $a = [1, $b, $c];
97    $b->{a} = $a;
98    $b->{b} = $a->[1];
99    $b->{c} = $a->[2];
100    @o{qw(a b c)} = ($a, $b, $c);
101    $o{d} = "{once upon a time}";
102    $o{e} = 1024;
103    $o{f} = 1024.1024;
104
105    my $struct = [@o{qw(a b c)}];
106    ::ok 9, ::_compare([$a, $b, $c], $struct);
107    ::ok 10, $o{d} eq "{once upon a time}" ;
108    ::ok 11, $o{e} == 1024 ;
109    ::ok 12, $o{f} eq 1024.1024 ;
110
111}
112