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