cygwin update (from Eric Fifer)

[p5sagit/p5-mst-13.2.git] / t / lib / db-hash.t

diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t
index 21f2aad..c52d8ae 100755 (executable)
--- a/t/lib/db-hash.t
+++ b/t/lib/db-hash.t
@@ -4,7 +4,7 @@ BEGIN {
     unshift @INC, '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0\n";
+       print "1..0 # Skip: DB_File was not built\n";
        exit 0;
     }
 }
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..108\n";
+print "1..109\n";
 
 sub ok
 {
@@ -23,6 +23,39 @@ sub ok
     print "ok $no\n" ;
 }
 
+{
+    package Redirect ;
+    use Symbol ;
+
+    sub new
+    {
+        my $class = shift ;
+        my $filename = shift ;
+       my $fh = gensym ;
+       open ($fh, ">$filename") || die "Cannot open $filename: $!" ;
+       my $real_stdout = select($fh) ;
+       return bless [$fh, $real_stdout ] ;
+
+    }
+    sub DESTROY
+    {
+        my $self = shift ;
+       close $self->[0] ;
+       select($self->[1]) ;
+    }
+}
+
+sub docat_del
+{ 
+    my $file = shift;
+    local $/ = undef;
+    open(CAT,$file) || die "Cannot open $file: $!";
+    my $result = <CAT>;
+    close(CAT);
+    unlink $file ;
+    return $result;
+}   
+
 my $Dfile = "dbhash.tmp";
 unlink $Dfile;
 
@@ -164,6 +197,8 @@ ok(25, $#keys == 31) ;
 $h{'foo'} = '';
 ok(26, $h{'foo'} eq '' );
 
+# Berkeley DB 2 from version 2.4.10 onwards does not allow null keys.
+# This feature will be reenabled in a future version of Berkeley DB.
 #$h{''} = 'bar';
 #ok(27, $h{''} eq 'bar' );
 ok(27,1) ;
@@ -600,4 +635,51 @@ EOM
    unlink $Dfile;
 }
 
+
+{
+   # Examples from the POD
+
+  my $file = "xyzt" ;
+  {
+    my $redirect = new Redirect $file ;
+
+    use strict ;
+    use DB_File ;
+    use vars qw( %h $k $v ) ;
+
+    unlink "fruit" ;
+    tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0640, $DB_HASH 
+        or die "Cannot open file 'fruit': $!\n";
+
+    # Add a few key/value pairs to the file
+    $h{"apple"} = "red" ;
+    $h{"orange"} = "orange" ;
+    $h{"banana"} = "yellow" ;
+    $h{"tomato"} = "red" ;
+
+    # Check for existence of a key
+    print "Banana Exists\n\n" if $h{"banana"} ;
+
+    # Delete a key/value pair.
+    delete $h{"apple"} ;
+
+    # print the contents of the file
+    while (($k, $v) = each %h)
+      { print "$k -> $v\n" }
+
+    untie %h ;
+
+    unlink "fruit" ;
+  }  
+
+  ok(109, docat_del($file) eq <<'EOM') ;
+Banana Exists
+
+orange -> orange
+tomato -> red
+banana -> yellow
+EOM
+   
+}
+
 exit ;