diff options
Diffstat (limited to 'gnu/usr.bin/perl/t/lib/gdbm.t')
| -rw-r--r-- | gnu/usr.bin/perl/t/lib/gdbm.t | 101 |
1 files changed, 95 insertions, 6 deletions
diff --git a/gnu/usr.bin/perl/t/lib/gdbm.t b/gnu/usr.bin/perl/t/lib/gdbm.t index 92e4eb219de..53b0351ed3a 100644 --- a/gnu/usr.bin/perl/t/lib/gdbm.t +++ b/gnu/usr.bin/perl/t/lib/gdbm.t @@ -1,6 +1,6 @@ #!./perl -# $RCSfile: gdbm.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:15 $ +# $RCSfile: gdbm.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:00:31 $ BEGIN { @INC = '../lib'; @@ -13,7 +13,7 @@ BEGIN { use GDBM_File; -print "1..12\n"; +print "1..20\n"; unlink <Op.dbmx*>; @@ -24,9 +24,14 @@ $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op.dbmx*>; } -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat($Dfile); -print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); +if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') { + print "ok 2\n"; +} +else { + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); + print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); +} while (($key,$value) = each(%h)) { $i++; } @@ -83,7 +88,7 @@ delete $h{'goner3'}; if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";} while (($key,$value) = each(h)) { - if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) { + if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { $key =~ y/a-z/A-Z/; $i++ if $key eq $value; } @@ -114,4 +119,88 @@ print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n"; print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); 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*> ; + +} |