summaryrefslogtreecommitdiff
path: root/t/lib/gdbm.t
diff options
context:
space:
mode:
Diffstat (limited to 't/lib/gdbm.t')
-rwxr-xr-xt/lib/gdbm.t85
1 files changed, 84 insertions, 1 deletions
diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t
index a0f081fa1e..37660c26c6 100755
--- a/t/lib/gdbm.t
+++ b/t/lib/gdbm.t
@@ -13,7 +13,7 @@ BEGIN {
use GDBM_File;
-print "1..12\n";
+print "1..20\n";
unlink <Op.dbmx*>;
@@ -121,3 +121,86 @@ 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 GDBM_File;
+ @ISA=qw(GDBM_File);
+ @EXPORT = @GDBM_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 ; ';
+ main::ok(13, $@ eq "") ;
+ my %h ;
+ my $X ;
+ eval '
+ $X = tie(%h, "SubDB","dbhash.tmp", &GDBM_WRCREAT, 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 ' &GDBM_WRCREAT eq &main::GDBM_WRCREAT ' ;
+ main::ok(17, $@ eq "" ) ;
+ main::ok(18, $ret == 1) ;
+
+ $ret = eval '$X->A_new_method("fred") ' ;
+ main::ok(19, $@ eq "") ;
+ main::ok(20, $ret eq "[[5]]") ;
+
+ unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}