fix CJKT.t failures on windows due to incorrect binmode()

[p5sagit/p5-mst-13.2.git] / ext / SDBM_File / sdbm.t

diff --git a/ext/SDBM_File/sdbm.t b/ext/SDBM_File/sdbm.t
index f942b97..8106289 100644 (file)
--- a/ext/SDBM_File/sdbm.t
+++ b/ext/SDBM_File/sdbm.t
@@ -28,7 +28,7 @@ require SDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..74\n";
+print "1..80\n";
 
 unlink <Op_dbmx.*>;
 
@@ -439,7 +439,7 @@ unlink <Op_dbmx*>, $Dfile;
     use strict ;
     use SDBM_File ;
 
-    unlink <Op.dbmx*>;
+    unlink <Op_dbmx*>;
     my $bad_key = 0 ;
     my %h = () ;
     ok(69, my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
@@ -466,7 +466,51 @@ unlink <Op_dbmx*>, $Dfile;
 
     undef $db ;
     untie %h ;
-    unlink <Op.dbmx*>;
+    unlink <Op_dbmx*>;
 }
 
+
+{
+   # Check that DBM Filter can cope with read-only $_
+
+   use warnings ;
+   use strict ;
+   my %h ;
+   unlink <Op1_dbmx*>;
+
+   ok(75, my $db = tie(%h, 'SDBM_File','Op1_dbmx', O_RDWR|O_CREAT, 0640)) ;
+
+   $db->filter_fetch_key   (sub { }) ;
+   $db->filter_store_key   (sub { }) ;
+   $db->filter_fetch_value (sub { }) ;
+   $db->filter_store_value (sub { }) ;
+
+   $_ = "original" ;
+
+   $h{"fred"} = "joe" ;
+   ok(76, $h{"fred"} eq "joe");
+
+   eval { grep { $h{$_} } (1, 2, 3) };
+   ok (77, ! $@);
+
+
+   # delete the filters
+   $db->filter_fetch_key   (undef);
+   $db->filter_store_key   (undef);
+   $db->filter_fetch_value (undef);
+   $db->filter_store_value (undef);
+
+   $h{"fred"} = "joe" ;
+
+   ok(78, $h{"fred"} eq "joe");
+
+   ok(79, $db->FIRSTKEY() eq "fred") ;
+   
+   eval { grep { $h{$_} } (1, 2, 3) };
+   ok (80, ! $@);
+
+   undef $db ;
+   untie %h;
+   unlink <Op1_dbmx*>;
+}
 exit ;