Major changes to the DOS/djgpp port (including threading):

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

diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t
index 9928847..90dbb84 100755 (executable)
--- a/t/lib/sdbm.t
+++ b/t/lib/sdbm.t
@@ -15,7 +15,7 @@ require SDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..12\n";
+print "1..18\n";
 
 unlink <Op.dbmx*>;
 
@@ -27,8 +27,8 @@ $Dfile = "Op.dbmx.pag";
 if (! -e $Dfile) {
        ($Dfile) = <Op.dbmx*>;
 }
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
-    print "ok 2\n";
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
+    print "ok 2 # Skipped: different file permission semantics\n";
 }
 else {
     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
@@ -124,3 +124,84 @@ print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
 untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use SDBM_File;
+   @ISA=qw(SDBM_File);
+   @EXPORT = @SDBM_File::EXPORT if defined @SDBM_File::EXPORT ;
+
+   sub STORE { 
+       my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+       my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+       my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+       return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ;';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+       $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+       ' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}