DB_File 1.05

[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 527dfc9..e6ffa6b 100755 (executable)
--- a/t/lib/db-hash.t
+++ b/t/lib/db-hash.t
@@ -1,9 +1,7 @@
-#!./perl 
 #!./perl -w 
 
 BEGIN {
-    #@INC = '../lib' if -d '../lib' ;
-    @INC = '../lib' ;
+    @INC = '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
        print "1..0\n";
@@ -14,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..48\n";
+print "1..51\n";
 
 sub ok
 {
@@ -34,14 +32,14 @@ umask(0);
 
 my $dbh = new DB_File::HASHINFO ;
 
+ok(1, $dbh->{bsize} == 0) ;
+ok(2, $dbh->{ffactor} == 0) ;
+ok(3, $dbh->{nelem} == 0) ;
+ok(4, $dbh->{cachesize} == 0) ;
 $^W = 0 ;
-ok(1, $dbh->{bsize} == undef) ;
-ok(2, $dbh->{ffactor} == undef) ;
-ok(3, $dbh->{nelem} == undef) ;
-ok(4, $dbh->{cachesize} == undef) ;
 ok(5, $dbh->{hash} == undef) ;
-ok(6, $dbh->{lorder} == undef) ;
 $^W = 1 ;
+ok(6, $dbh->{lorder} == 0) ;
 
 $dbh->{bsize} = 3000 ;
 ok(7, $dbh->{bsize} == 3000 );
@@ -64,9 +62,10 @@ ok(12, $dbh->{lorder} == 1234 );
 # Check that an invalid entry is caught both for store & fetch
 eval '$dbh->{fred} = 1234' ;
 ok(13, $@ =~ /^DB_File::HASHINFO::STORE - Unknown element 'fred' at/ );
-eval '$q = $dbh->{fred}' ;
+eval 'my $q = $dbh->{fred}' ;
 ok(14, $@ =~ /^DB_File::HASHINFO::FETCH - Unknown element 'fred' at/ );
 
+
 # Now check the interface to HASH
 
 ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
@@ -295,7 +294,22 @@ ok(47, $X = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
 $status = $X->fd ;
 ok(48, $status == -1 );
 
-untie %h ;
 undef $X ;
+untie %h ;
+
+{
+    # check ability to override the default hashing
+    my %x ;
+    my $filename = "xyz" ;
+    my $hi = new DB_File::HASHINFO ;
+    $::count = 0 ;
+    $hi->{hash} = sub { ++$::count ; length $_[0] } ;
+    ok(49, tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $hi ) ;
+    $h{"abc"} = 123 ;
+    ok(50, $h{"abc"} == 123) ;
+    untie %x ;
+    unlink $filename ;
+    ok(51, $::count >0) ;
+}
 
 exit ;