mldbm.t
上传用户:tsgydb
上传日期:2007-04-14
资源大小:10674k
文件大小:3k
源码类别:

MySQL数据库

开发平台:

Visual C++

  1. #!/usr/bin/perl -w
  2. BEGIN 
  3. {
  4.     if ($] < 5.005) {
  5. print "1..0 # This is Perl $], skipping testn" ;
  6. exit 0 ;
  7.     }
  8.     eval { require Data::Dumper ; };
  9.     if ($@) {
  10. print "1..0 # Data::Dumper is not installed on this system.n";
  11. exit 0 ;
  12.     }
  13.     if ($Data::Dumper::VERSION < 2.08) {
  14. print "1..0 # Data::Dumper 2.08 or better required (found $Data::Dumper::VERSION).n";
  15. exit 0 ;
  16.     }
  17.     eval { require MLDBM ; };
  18.     if ($@) {
  19. print "1..0 # MLDBM is not installed on this system.n";
  20. exit 0 ;
  21.     }
  22. }
  23. sub ok
  24. {
  25.     my $no = shift ;
  26.     my $result = shift ;
  27.  
  28.     print "not " unless $result ;
  29.     print "ok $non" ;
  30. }
  31. print "1..12n";
  32. {
  33. package BTREE ;
  34. use BerkeleyDB ;
  35. use MLDBM qw(BerkeleyDB::Btree) ; 
  36. use Data::Dumper;
  37. $filename = 'testmldbm' ;
  38. unlink $filename ;
  39. $MLDBM::UseDB = "BerkeleyDB::Btree" ;
  40. $db = tie %o, MLDBM, -Filename => $filename,
  41.      -Flags    => DB_CREATE
  42. or die $!;
  43. ::ok 1, $db ;
  44. ::ok 2, $db->type() == DB_BTREE ;
  45. $c = ['c'];
  46. $b = {};
  47. $a = [1, $b, $c];
  48. $b->{a} = $a;
  49. $b->{b} = $a->[1];
  50. $b->{c} = $a->[2];
  51. @o{qw(a b c)} = ($a, $b, $c);
  52. $o{d} = "{once upon a time}";
  53. $o{e} = 1024;
  54. $o{f} = 1024.1024;
  55. $first = Data::Dumper->new([@o{qw(a b c)}], [qw(a b c)])->Quotekeys(0)->Dump;
  56. $second = <<'EOT';
  57. $a = [
  58.        1,
  59.        {
  60.          a => $a,
  61.          b => $a->[1],
  62.          c => [
  63.                 'c'
  64.               ]
  65.        },
  66.        $a->[1]{c}
  67.      ];
  68. $b = {
  69.        a => [
  70.               1,
  71.               $b,
  72.               [
  73.                 'c'
  74.               ]
  75.             ],
  76.        b => $b,
  77.        c => $b->{a}[2]
  78.      };
  79. $c = [
  80.        'c'
  81.      ];
  82. EOT
  83. ::ok 3, $first eq $second ;
  84. ::ok 4, $o{d} eq "{once upon a time}" ;
  85. ::ok 5, $o{e} == 1024 ;
  86. ::ok 6, $o{f} eq 1024.1024 ;
  87. unlink $filename ;
  88. }
  89. {
  90. package HASH ;
  91. use BerkeleyDB ;
  92. use MLDBM qw(BerkeleyDB::Hash) ; 
  93. use Data::Dumper;
  94. $filename = 'testmldbm' ;
  95. unlink $filename ;
  96. $MLDBM::UseDB = "BerkeleyDB::Hash" ;
  97. $db = tie %o, MLDBM, -Filename => $filename,
  98.      -Flags    => DB_CREATE
  99. or die $!;
  100. ::ok 7, $db ;
  101. ::ok 8, $db->type() == DB_HASH ;
  102. $c = ['c'];
  103. $b = {};
  104. $a = [1, $b, $c];
  105. $b->{a} = $a;
  106. $b->{b} = $a->[1];
  107. $b->{c} = $a->[2];
  108. @o{qw(a b c)} = ($a, $b, $c);
  109. $o{d} = "{once upon a time}";
  110. $o{e} = 1024;
  111. $o{f} = 1024.1024;
  112. $first = Data::Dumper->new([@o{qw(a b c)}], [qw(a b c)])->Quotekeys(0)->Dump;
  113. $second = <<'EOT';
  114. $a = [
  115.        1,
  116.        {
  117.          a => $a,
  118.          b => $a->[1],
  119.          c => [
  120.                 'c'
  121.               ]
  122.        },
  123.        $a->[1]{c}
  124.      ];
  125. $b = {
  126.        a => [
  127.               1,
  128.               $b,
  129.               [
  130.                 'c'
  131.               ]
  132.             ],
  133.        b => $b,
  134.        c => $b->{a}[2]
  135.      };
  136. $c = [
  137.        'c'
  138.      ];
  139. EOT
  140. ::ok 9, $first eq $second ;
  141. ::ok 10, $o{d} eq "{once upon a time}" ;
  142. ::ok 11, $o{e} == 1024 ;
  143. ::ok 12, $o{f} eq 1024.1024 ;
  144. unlink $filename ;
  145. }