In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b2c1001218590c2d715561a2426f97a8c21d7a4d?hp=2bacf45196adffa38459d666fa7e41411f3b4eb0>
- Log ----------------------------------------------------------------- commit b2c1001218590c2d715561a2426f97a8c21d7a4d Author: Nicholas Clark <[email protected]> Date: Wed Dec 15 16:48:48 2010 +0000 Convert ext/SDBM_File/t/sdbm.t to Test::More. M ext/SDBM_File/t/sdbm.t commit 876dc03f966ba074f9493db31bbdf8fb020c5987 Author: Nicholas Clark <[email protected]> Date: Wed Dec 15 16:20:39 2010 +0000 Convert ext/ODBM_File/t/odbm.t to Test::More. M ext/ODBM_File/t/odbm.t commit 3dda4482c401b2b51c642dda5e2750fa442c0b70 Author: Nicholas Clark <[email protected]> Date: Wed Dec 15 16:01:55 2010 +0000 Convert ext/NDBM_File/t/ndbm.t to Test::More. M ext/NDBM_File/t/ndbm.t commit 77caf3e9082be15294aff3cfa2a3d783e17aed47 Author: Nicholas Clark <[email protected]> Date: Wed Dec 15 15:25:33 2010 +0000 Convert ext/GDBM_File/t/gdbm.t to Test::More. M ext/GDBM_File/t/gdbm.t commit 27b757ee1ecd8a0e9af94b3b1d42adae74534681 Author: Nicholas Clark <[email protected]> Date: Wed Dec 15 15:08:04 2010 +0000 Remove redundant use strict,warnings,?DBM_File from ext/?DBM_File/t/?dbm.t. M ext/GDBM_File/t/gdbm.t M ext/NDBM_File/t/ndbm.t M ext/ODBM_File/t/odbm.t M ext/SDBM_File/t/sdbm.t ----------------------------------------------------------------------- Summary of changes: ext/GDBM_File/t/gdbm.t | 214 +++++++++++++++++++++--------------------------- ext/NDBM_File/t/ndbm.t | 202 ++++++++++++++++++++------------------------- ext/ODBM_File/t/odbm.t | 205 ++++++++++++++++++++------------------------- ext/SDBM_File/t/sdbm.t | 211 +++++++++++++++++++++-------------------------- 4 files changed, 368 insertions(+), 464 deletions(-) diff --git a/ext/GDBM_File/t/gdbm.t b/ext/GDBM_File/t/gdbm.t index c0addb0..5cdedcc 100644 --- a/ext/GDBM_File/t/gdbm.t +++ b/ext/GDBM_File/t/gdbm.t @@ -13,34 +13,32 @@ BEGIN { use strict; use warnings; - +use Test::More tests => 81; use GDBM_File; -print "1..80\n"; - unlink <Op.dbmx*>; umask(0); my %h ; -print (tie(%h,'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 1\n" : "not ok 1\n"); +isa_ok(tie(%h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); my $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op.dbmx*>; } -if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin') { - print "ok 2 # Skipped: different file permission semantics\n"; -} -else { +SKIP: { + skip " different file permission semantics on $^O", 1 + if $^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin'; + my ($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"); + is($mode & 0777, 0640); } my $i = 0; while (my ($key,$value) = each(%h)) { $i++; } -print (!$i ? "ok 3\n" : "not ok 3\n"); +is($i, 0); $h{'goner1'} = 'snork'; @@ -62,7 +60,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -print (tie(%h,'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 4\n" : "not ok 4\n"); +isa_ok(tie(%h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -90,7 +88,8 @@ delete $h{'goner3'}; my @keys = keys(%h); my @values = values(%h); -if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";} +is($#keys, 29); +is($#values, 29); while (my ($key,$value) = each(%h)) { if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { @@ -99,51 +98,38 @@ while (my ($key,$value) = each(%h)) { } } -if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";} +is($i, 30); @keys = ('blurfl', keys(%h), 'dyick'); -if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";} +is($#keys, 31); $h{'foo'} = ''; $h{''} = 'bar'; -# check cache overflow and numeric keys and contents my $ok = 1; for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; } for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; } -print ($ok ? "ok 8\n" : "not ok 8\n"); +is($ok, 1, 'check cache overflow and numeric keys and contents'); my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat($Dfile); -print ($size > 0 ? "ok 9\n" : "not ok 9\n"); +cmp_ok($size, '>', 0); @h{0..200} = 200..400; my @foo = @h{0..200}; -print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n"; +is(join(':',200..400), join(':',@foo)); -print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); -print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); +is($h{'foo'}, ''); +is($h{''}, 'bar'); 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 ; - use warnings ; - open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; print FILE <<'EOM' ; @@ -187,26 +173,26 @@ EOM unlink <dbhash.tmp*> ; eval 'use SubDB ; '; - main::ok(13, $@ eq "") ; + main::is($@, ""); my %h ; my $X ; eval ' $X = tie(%h, "SubDB","dbhash.tmp", &GDBM_WRCREAT, 0640 ); ' ; - main::ok(14, $@ eq "") ; + main::is($@, ""); my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ; - main::ok(15, $@ eq "") ; - main::ok(16, $ret == 5) ; + main::is($@, ""); + main::is($ret, 5); $ret = eval ' &GDBM_WRCREAT eq &main::GDBM_WRCREAT ' ; - main::ok(17, $@ eq "" ) ; - main::ok(18, $ret == 1) ; + main::is($@, ""); + main::is($ret, 1); $ret = eval '$X->A_new_method("fred") ' ; - main::ok(19, $@ eq "") ; - main::ok(20, $ret eq "[[5]]") ; + main::is($@, ""); + main::is($ret, "[[5]]"); undef $X; untie(%h); @@ -216,8 +202,6 @@ EOM { # DBM Filter tests - use strict ; - use warnings ; my (%h, $db) ; my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; @@ -231,7 +215,8 @@ EOM } unlink <Op.dbmx*>; - ok(21, $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)) ; + $db = tie %h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, 'GDBM_File'); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; $db->filter_store_key (sub { $store_key = $_ }) ; @@ -242,17 +227,17 @@ EOM $h{"fred"} = "joe" ; # fk sk fv sv - ok(22, checkOutput( "", "fred", "", "joe")) ; + ok(checkOutput("", "fred", "", "joe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(23, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); # fk sk fv sv - ok(24, checkOutput( "", "fred", "joe", "")) ; + ok(checkOutput("", "fred", "joe", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(25, $db->FIRSTKEY() eq "fred") ; + is($db->FIRSTKEY(), "fred"); # fk sk fv sv - ok(26, checkOutput( "fred", "", "", "")) ; + ok(checkOutput("fred", "", "", "")); # replace the filters, but remember the previous set my ($old_fk) = $db->filter_fetch_key @@ -267,17 +252,17 @@ EOM ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"Fred"} = "Joe" ; # fk sk fv sv - ok(27, checkOutput( "", "fred", "", "Jxe")) ; + ok(checkOutput("", "fred", "", "Jxe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(28, $h{"Fred"} eq "[Jxe]"); + is($h{"Fred"}, "[Jxe]"); # fk sk fv sv - ok(29, checkOutput( "", "fred", "[Jxe]", "")) ; + ok(checkOutput("", "fred", "[Jxe]", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(30, $db->FIRSTKEY() eq "FRED") ; + is($db->FIRSTKEY(), "FRED"); # fk sk fv sv - ok(31, checkOutput( "FRED", "", "", "")) ; + ok(checkOutput("FRED", "", "", "")); # put the original filters back $db->filter_fetch_key ($old_fk); @@ -287,15 +272,15 @@ EOM ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"fred"} = "joe" ; - ok(32, checkOutput( "", "fred", "", "joe")) ; + ok(checkOutput("", "fred", "", "joe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(33, $h{"fred"} eq "joe"); - ok(34, checkOutput( "", "fred", "joe", "")) ; + is($h{"fred"}, "joe"); + ok(checkOutput("", "fred", "joe", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(35, $db->FIRSTKEY() eq "fred") ; - ok(36, checkOutput( "fred", "", "", "")) ; + is($db->FIRSTKEY(), "fred"); + ok(checkOutput("fred", "", "", "")); # delete the filters $db->filter_fetch_key (undef); @@ -305,15 +290,15 @@ EOM ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"fred"} = "joe" ; - ok(37, checkOutput( "", "", "", "")) ; + ok(checkOutput("", "", "", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(38, $h{"fred"} eq "joe"); - ok(39, checkOutput( "", "", "", "")) ; + is($h{"fred"}, "joe"); + ok(checkOutput("", "", "", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(40, $db->FIRSTKEY() eq "fred") ; - ok(41, checkOutput( "", "", "", "")) ; + is($db->FIRSTKEY(), "fred"); + ok(checkOutput("", "", "", "")); undef $db ; untie %h; @@ -323,12 +308,11 @@ EOM { # DBM Filter with a closure - use strict ; - use warnings ; my (%h, $db) ; unlink <Op.dbmx*>; - ok(42, $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)) ; + $db = tie %h, 'GDBM_File','Op.dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, 'GDBM_File'); my %result = () ; @@ -352,32 +336,32 @@ EOM $_ = "original" ; $h{"fred"} = "joe" ; - ok(43, $result{"store key"} eq "store key - 1: [fred]"); - ok(44, $result{"store value"} eq "store value - 1: [joe]"); - ok(45, !defined $result{"fetch key"} ); - ok(46, !defined $result{"fetch value"} ); - ok(47, $_ eq "original") ; - - ok(48, $db->FIRSTKEY() eq "fred") ; - ok(49, $result{"store key"} eq "store key - 1: [fred]"); - ok(50, $result{"store value"} eq "store value - 1: [joe]"); - ok(51, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(52, ! defined $result{"fetch value"} ); - ok(53, $_ eq "original") ; + is($result{"store key"}, "store key - 1: [fred]"); + is($result{"store value"}, "store value - 1: [joe]"); + is($result{"fetch key"}, undef); + is($result{"fetch value"}, undef); + is($_, "original"); + + is($db->FIRSTKEY(), "fred"); + is($result{"store key"}, "store key - 1: [fred]"); + is($result{"store value"}, "store value - 1: [joe]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, undef); + is($_, "original"); $h{"jim"} = "john" ; - ok(54, $result{"store key"} eq "store key - 2: [fred jim]"); - ok(55, $result{"store value"} eq "store value - 2: [joe john]"); - ok(56, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(57, ! defined $result{"fetch value"} ); - ok(58, $_ eq "original") ; - - ok(59, $h{"fred"} eq "joe"); - ok(60, $result{"store key"} eq "store key - 3: [fred jim fred]"); - ok(61, $result{"store value"} eq "store value - 2: [joe john]"); - ok(62, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(63, $result{"fetch value"} eq "fetch value - 1: [joe]"); - ok(64, $_ eq "original") ; + is($result{"store key"}, "store key - 2: [fred jim]"); + is($result{"store value"}, "store value - 2: [joe john]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, undef); + is($_, "original"); + + is($h{"fred"}, "joe"); + is($result{"store key"}, "store key - 3: [fred jim fred]"); + is($result{"store value"}, "store value - 2: [joe john]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, "fetch value - 1: [joe]"); + is($_, "original"); undef $db ; untie %h; @@ -386,17 +370,16 @@ EOM { # DBM Filter recursion detection - use strict ; - use warnings ; my (%h, $db) ; unlink <Op.dbmx*>; - ok(65, $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)) ; + $db = tie %h, 'GDBM_File','Op.dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, 'GDBM_File'); $db->filter_store_key (sub { $_ = $h{$_} }) ; eval '$h{1} = 1234' ; - ok(66, $@ =~ /^recursion detected in filter_store_key at/ ); + like($@, qr/^recursion detected in filter_store_key at/); undef $db ; untie %h; @@ -408,18 +391,15 @@ EOM # # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - use warnings ; - use strict ; - use GDBM_File ; unlink <Op.dbmx*>; my %h ; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - - ok(67, tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)); + + isa_ok(tie(%h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); $h{ABC} = undef; - ok(68, $a eq "") ; + is($a, ""); untie %h; unlink <Op.dbmx*>; } @@ -431,34 +411,31 @@ EOM # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - use warnings ; - use strict ; - use GDBM_File ; - unlink <Op.dbmx*>; my $bad_key = 0 ; my %h = () ; - ok(69, my $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)); + my $db = tie %h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, 'GDBM_File'); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; $h{'Alpha_ABC'} = 2 ; $h{'Alpha_DEF'} = 5 ; - ok(70, $h{'Alpha_ABC'} == 2); - ok(71, $h{'Alpha_DEF'} == 5); + is($h{'Alpha_ABC'}, 2); + is($h{'Alpha_DEF'}, 5); my ($k, $v) = ("",""); while (($k, $v) = each %h) {} - ok(72, $bad_key == 0); + is($bad_key, 0); $bad_key = 0 ; foreach $k (keys %h) {} - ok(73, $bad_key == 0); + is($bad_key, 0); $bad_key = 0 ; foreach $v (values %h) {} - ok(74, $bad_key == 0); + is($bad_key, 0); undef $db ; untie %h ; @@ -468,12 +445,12 @@ EOM { # Check that DBM Filter can cope with read-only $_ - use warnings ; - use strict ; my %h ; unlink <Op.dbmx*>; - ok(75, my $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)); + my $db = tie %h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, 'GDBM_File'); + $db->filter_fetch_key (sub { }) ; $db->filter_store_key (sub { }) ; @@ -483,10 +460,10 @@ EOM $_ = "original" ; $h{"fred"} = "joe" ; - ok(76, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); eval { my @r= grep { $h{$_} } (1, 2, 3) }; - ok (77, ! $@); + is($@, ''); # delete the filters @@ -497,15 +474,14 @@ EOM $h{"fred"} = "joe" ; - ok(78, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); - ok(79, $db->FIRSTKEY() eq "fred") ; + is($db->FIRSTKEY(), "fred"); eval { my @r= grep { $h{$_} } (1, 2, 3) }; - ok (80, ! $@); + is($@, ''); undef $db ; untie %h; unlink <Op.dbmx*>; } -exit ; diff --git a/ext/NDBM_File/t/ndbm.t b/ext/NDBM_File/t/ndbm.t index 8956676..8bbd293 100644 --- a/ext/NDBM_File/t/ndbm.t +++ b/ext/NDBM_File/t/ndbm.t @@ -13,44 +13,34 @@ BEGIN { use strict; use warnings; -sub ok -{ - my $no = shift ; - my $result = shift ; - - print "not " unless $result ; - print "ok $no\n" ; -} +use Test::More tests => 78; require NDBM_File; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; -print "1..77\n"; - unlink <Op.dbmx*>; umask(0); my %h; -ok(1, tie(%h,'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)); +isa_ok(tie(%h,'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640), 'NDBM_File'); my $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op.dbmx*>; } -if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'MacOS') { - print "ok 2 # Skipped: different file permission semantics\n"; -} -else { +SKIP: { + skip "different file permission semantics on $^O", 1 + if $^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare'; my ($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"); + is($mode & 0777, 0640); } my $i = 0; while (my ($key,$value) = each(%h)) { $i++; } -print (!$i ? "ok 3\n" : "not ok 3\n"); +is($i, 0); $h{'goner1'} = 'snork'; @@ -72,7 +62,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -print (tie(%h,'NDBM_File','Op.dbmx', &O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); +isa_ok(tie(%h,'NDBM_File','Op.dbmx', O_RDWR, 0640), 'NDBM_File'); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -100,7 +90,8 @@ delete $h{'goner3'}; my @keys = keys(%h); my @values = values(%h); -if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";} +is($#keys, 29); +is($#values, 29); while (my ($key,$value) = each(%h)) { if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { @@ -109,30 +100,29 @@ while (my ($key,$value) = each(%h)) { } } -if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";} +is($i, 30); @keys = ('blurfl', keys(%h), 'dyick'); -if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";} +is($#keys, 31); $h{'foo'} = ''; $h{''} = 'bar'; -# check cache overflow and numeric keys and contents my $ok = 1; for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; } for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; } -print ($ok ? "ok 8\n" : "not ok 8\n"); +is($ok, 1, 'check cache overflow and numeric keys and contents'); my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat($Dfile); -print ($size > 0 ? "ok 9\n" : "not ok 9\n"); +cmp_ok($size, '>', 0); @h{0..200} = 200..400; my @foo = @h{0..200}; -print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n"; +is(join(':',200..400), join(':',@foo)); -print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); -print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); +is($h{'foo'}, ''); +is($h{''}, 'bar'); untie %h; unlink <Op.dbmx*>, $Dfile; @@ -142,9 +132,6 @@ unlink <Op.dbmx*>, $Dfile; package Another ; - use strict ; - use warnings ; - open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; print FILE <<'EOM' ; @@ -188,22 +175,22 @@ EOM BEGIN { push @INC, '.'; } eval 'use SubDB ; use Fcntl ; '; - main::ok(13, $@ eq "") ; + main::is($@, ""); my %h ; my $X ; eval ' $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 ); ' ; - main::ok(14, $@ eq "") ; + main::is($@, ""); my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ; - main::ok(15, $@ eq "") ; - main::ok(16, $ret == 5) ; + main::is($@, ""); + main::is($ret, 5); $ret = eval '$X->A_new_method("fred") ' ; - main::ok(17, $@ eq "") ; - main::ok(18, $ret eq "[[5]]") ; + main::is($@, ""); + main::is($ret, "[[5]]"); undef $X; untie(%h); @@ -213,8 +200,6 @@ EOM { # DBM Filter tests - use strict ; - use warnings ; my (%h, $db) ; my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; @@ -228,7 +213,8 @@ EOM } unlink <Op.dbmx*>; - ok(19, $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + $db = tie %h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'NDBM_File'); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; $db->filter_store_key (sub { $store_key = $_ }) ; @@ -239,17 +225,17 @@ EOM $h{"fred"} = "joe" ; # fk sk fv sv - ok(20, checkOutput( "", "fred", "", "joe")) ; + ok(checkOutput("", "fred", "", "joe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(21, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); # fk sk fv sv - ok(22, checkOutput( "", "fred", "joe", "")) ; + ok(checkOutput("", "fred", "joe", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(23, $db->FIRSTKEY() eq "fred") ; + is($db->FIRSTKEY(), "fred"); # fk sk fv sv - ok(24, checkOutput( "fred", "", "", "")) ; + ok(checkOutput("fred", "", "", "")); # replace the filters, but remember the previous set my ($old_fk) = $db->filter_fetch_key @@ -264,17 +250,17 @@ EOM ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"Fred"} = "Joe" ; # fk sk fv sv - ok(25, checkOutput( "", "fred", "", "Jxe")) ; + ok(checkOutput("", "fred", "", "Jxe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(26, $h{"Fred"} eq "[Jxe]"); + is($h{"Fred"}, "[Jxe]"); # fk sk fv sv - ok(27, checkOutput( "", "fred", "[Jxe]", "")) ; + ok(checkOutput("", "fred", "[Jxe]", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(28, $db->FIRSTKEY() eq "FRED") ; + is($db->FIRSTKEY(), "FRED"); # fk sk fv sv - ok(29, checkOutput( "FRED", "", "", "")) ; + ok(checkOutput("FRED", "", "", "")); # put the original filters back $db->filter_fetch_key ($old_fk); @@ -284,15 +270,15 @@ EOM ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"fred"} = "joe" ; - ok(30, checkOutput( "", "fred", "", "joe")) ; + ok(checkOutput("", "fred", "", "joe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(31, $h{"fred"} eq "joe"); - ok(32, checkOutput( "", "fred", "joe", "")) ; + is($h{"fred"}, "joe"); + ok(checkOutput("", "fred", "joe", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(33, $db->FIRSTKEY() eq "fred") ; - ok(34, checkOutput( "fred", "", "", "")) ; + is($db->FIRSTKEY(), "fred"); + ok(checkOutput("fred", "", "", "")); # delete the filters $db->filter_fetch_key (undef); @@ -302,15 +288,15 @@ EOM ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"fred"} = "joe" ; - ok(35, checkOutput( "", "", "", "")) ; + ok(checkOutput("", "", "", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(36, $h{"fred"} eq "joe"); - ok(37, checkOutput( "", "", "", "")) ; + is($h{"fred"}, "joe"); + ok(checkOutput("", "", "", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(38, $db->FIRSTKEY() eq "fred") ; - ok(39, checkOutput( "", "", "", "")) ; + is($db->FIRSTKEY(), "fred"); + ok(checkOutput("", "", "", "")); undef $db ; untie %h; @@ -320,12 +306,11 @@ EOM { # DBM Filter with a closure - use strict ; - use warnings ; my (%h, $db) ; unlink <Op.dbmx*>; - ok(40, $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + $db = tie %h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'NDBM_File'); my %result = () ; @@ -349,32 +334,32 @@ EOM $_ = "original" ; $h{"fred"} = "joe" ; - ok(41, $result{"store key"} eq "store key - 1: [fred]"); - ok(42, $result{"store value"} eq "store value - 1: [joe]"); - ok(43, !defined $result{"fetch key"} ); - ok(44, !defined $result{"fetch value"} ); - ok(45, $_ eq "original") ; - - ok(46, $db->FIRSTKEY() eq "fred") ; - ok(47, $result{"store key"} eq "store key - 1: [fred]"); - ok(48, $result{"store value"} eq "store value - 1: [joe]"); - ok(49, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(50, ! defined $result{"fetch value"} ); - ok(51, $_ eq "original") ; + is($result{"store key"}, "store key - 1: [fred]"); + is($result{"store value"}, "store value - 1: [joe]"); + is($result{"fetch key"}, undef); + is($result{"fetch value"}, undef); + is($_, "original"); + + is($db->FIRSTKEY(), "fred"); + is($result{"store key"}, "store key - 1: [fred]"); + is($result{"store value"}, "store value - 1: [joe]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, undef); + is($_, "original"); $h{"jim"} = "john" ; - ok(52, $result{"store key"} eq "store key - 2: [fred jim]"); - ok(53, $result{"store value"} eq "store value - 2: [joe john]"); - ok(54, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(55, ! defined $result{"fetch value"} ); - ok(56, $_ eq "original") ; - - ok(57, $h{"fred"} eq "joe"); - ok(58, $result{"store key"} eq "store key - 3: [fred jim fred]"); - ok(59, $result{"store value"} eq "store value - 2: [joe john]"); - ok(60, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(61, $result{"fetch value"} eq "fetch value - 1: [joe]"); - ok(62, $_ eq "original") ; + is($result{"store key"}, "store key - 2: [fred jim]"); + is($result{"store value"}, "store value - 2: [joe john]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, undef); + is($_, "original"); + + is($h{"fred"}, "joe"); + is($result{"store key"}, "store key - 3: [fred jim fred]"); + is($result{"store value"}, "store value - 2: [joe john]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, "fetch value - 1: [joe]"); + is($_, "original"); undef $db ; untie %h; @@ -383,17 +368,16 @@ EOM { # DBM Filter recursion detection - use strict ; - use warnings ; my (%h, $db) ; unlink <Op.dbmx*>; - ok(63, $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + $db = tie %h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'NDBM_File'); $db->filter_store_key (sub { $_ = $h{$_} }) ; eval '$h{1} = 1234' ; - ok(64, $@ =~ /^recursion detected in filter_store_key at/ ); + like($@, qr/^recursion detected in filter_store_key at/); undef $db ; untie %h; @@ -405,16 +389,13 @@ EOM # # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - use warnings ; - use strict ; - use NDBM_File ; unlink <Op.dbmx*>; my %h ; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - ok(65, tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + isa_ok(tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640), 'NDBM_File'); } { @@ -424,34 +405,31 @@ EOM # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - use warnings ; - use strict ; - use NDBM_File ; - unlink <Op.dbmx*>; my $bad_key = 0 ; my %h = () ; - ok(66, my $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + my $db = tie %h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'NDBM_File'); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; $h{'Alpha_ABC'} = 2 ; $h{'Alpha_DEF'} = 5 ; - ok(67, $h{'Alpha_ABC'} == 2); - ok(68, $h{'Alpha_DEF'} == 5); + is($h{'Alpha_ABC'}, 2); + is($h{'Alpha_DEF'}, 5); my ($k, $v) = ("",""); while (($k, $v) = each %h) {} - ok(69, $bad_key == 0); + is($bad_key, 0); $bad_key = 0 ; foreach $k (keys %h) {} - ok(70, $bad_key == 0); + is($bad_key, 0); $bad_key = 0 ; foreach $v (values %h) {} - ok(71, $bad_key == 0); + is($bad_key, 0); undef $db ; untie %h ; @@ -462,12 +440,11 @@ EOM { # Check that DBM Filter can cope with read-only $_ - use warnings ; - use strict ; my %h ; unlink <Op.dbmx*>; - ok(72, my $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + my $db = tie %h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'NDBM_File'); $db->filter_fetch_key (sub { }) ; $db->filter_store_key (sub { }) ; @@ -477,10 +454,10 @@ EOM $_ = "original" ; $h{"fred"} = "joe" ; - ok(73, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); eval { grep { $h{$_} } (1, 2, 3) }; - ok (74, ! $@); + is($@, ''); # delete the filters @@ -491,15 +468,14 @@ EOM $h{"fred"} = "joe" ; - ok(75, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); - ok(76, $db->FIRSTKEY() eq "fred") ; + is($db->FIRSTKEY(), "fred"); eval { grep { $h{$_} } (1, 2, 3) }; - ok (77, ! $@); + is($@, ''); undef $db ; untie %h; unlink <Op.dbmx*>; } -exit ; diff --git a/ext/ODBM_File/t/odbm.t b/ext/ODBM_File/t/odbm.t index e9706ef..55ba0ad 100644 --- a/ext/ODBM_File/t/odbm.t +++ b/ext/ODBM_File/t/odbm.t @@ -13,44 +13,34 @@ BEGIN { use strict; use warnings; -sub ok -{ - my $no = shift ; - my $result = shift ; - - print "not " unless $result ; - print "ok $no\n" ; -} +use Test::More tests => 79; require ODBM_File; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; -print "1..78\n"; - unlink <Op.dbmx*>; umask(0); my %h; -ok(1, tie(%h,'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)); +isa_ok(tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640), 'ODBM_File'); my $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op.dbmx*>; } -if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare') { - print "ok 2 # Skipped: different file permission semantics\n"; -} -else { +SKIP: { + skip "different file permission semantics on $^O", 1 + if $^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare'; my ($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"); + is($mode & 0777, 0640); } my $i = 0; while (my ($key,$value) = each(%h)) { $i++; } -print (!$i ? "ok 3\n" : "not ok 3\n"); +is($i, 0); $h{'goner1'} = 'snork'; @@ -72,7 +62,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -print (tie(%h,'ODBM_File','Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); +isa_ok(tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR, 0640), 'ODBM_File'); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -100,7 +90,8 @@ delete $h{'goner3'}; my @keys = keys(%h); my @values = values(%h); -if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";} +is($#keys, 29); +is($#values, 29); while (my ($key,$value) = each(%h)) { if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { @@ -109,30 +100,29 @@ while (my ($key,$value) = each(%h)) { } } -if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";} +is($i, 30); @keys = ('blurfl', keys(%h), 'dyick'); -if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";} +is($#keys, 31); $h{'foo'} = ''; $h{''} = 'bar'; -# check cache overflow and numeric keys and contents my $ok = 1; for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; } for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; } -print ($ok ? "ok 8\n" : "not ok 8\n"); +is($ok, 1, 'check cache overflow and numeric keys and contents'); my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat($Dfile); -print ($size > 0 ? "ok 9\n" : "not ok 9\n"); +cmp_ok($size, '>', 0); @h{0..200} = 200..400; my @foo = @h{0..200}; -print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n"; +is(join(':',200..400), join(':',@foo)); -print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); -print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); +is($h{'foo'}, ''); +is($h{''}, 'bar'); untie %h; unlink 'Op.dbmx.dir', $Dfile; @@ -142,9 +132,6 @@ unlink 'Op.dbmx.dir', $Dfile; package Another ; - use strict ; - use warnings ; - open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; print FILE <<'EOM' ; @@ -188,22 +175,22 @@ EOM BEGIN { push @INC, '.'; } eval 'use SubDB ; use Fcntl ;'; - main::ok(13, $@ eq "") ; + main::is($@, ""); my %h ; my $X ; eval ' $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 ); ' ; - main::ok(14, $@ eq "") ; + main::is($@, ""); my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ; - main::ok(15, $@ eq "") ; - main::ok(16, $ret == 5) ; + main::is($@, ""); + main::is($ret, 5); $ret = eval '$X->A_new_method("fred") ' ; - main::ok(17, $@ eq "") ; - main::ok(18, $ret eq "[[5]]") ; + main::is($@, ""); + main::is($ret, "[[5]]"); undef $X; untie(%h); @@ -213,8 +200,6 @@ EOM { # DBM Filter tests - use strict ; - use warnings ; my (%h, $db) ; my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; @@ -230,7 +215,8 @@ EOM } unlink <Op.dbmx*>; - ok(19, $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + $db = tie %h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'ODBM_File'); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; $db->filter_store_key (sub { $store_key = $_ }) ; @@ -241,17 +227,17 @@ EOM $h{"fred"} = "joe" ; # fk sk fv sv - ok(20, checkOutput( "", "fred", "", "joe")) ; + ok(checkOutput("", "fred", "", "joe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(21, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); # fk sk fv sv - ok(22, checkOutput( "", "fred", "joe", "")) ; + ok(checkOutput("", "fred", "joe", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(23, $db->FIRSTKEY() eq "fred") ; + is($db->FIRSTKEY(), "fred"); # fk sk fv sv - ok(24, checkOutput( "fred", "", "", "")) ; + ok(checkOutput("fred", "", "", "")); # replace the filters, but remember the previous set my ($old_fk) = $db->filter_fetch_key @@ -266,17 +252,17 @@ EOM ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"Fred"} = "Joe" ; # fk sk fv sv - ok(25, checkOutput( "", "fred", "", "Jxe")) ; + ok(checkOutput("", "fred", "", "Jxe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(26, $h{"Fred"} eq "[Jxe]"); + is($h{"Fred"}, "[Jxe]"); # fk sk fv sv - ok(27, checkOutput( "", "fred", "[Jxe]", "")) ; + ok(checkOutput("", "fred", "[Jxe]", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(28, $db->FIRSTKEY() eq "FRED") ; + is($db->FIRSTKEY(), "FRED"); # fk sk fv sv - ok(29, checkOutput( "FRED", "", "", "")) ; + ok(checkOutput("FRED", "", "", "")); # put the original filters back $db->filter_fetch_key ($old_fk); @@ -286,15 +272,15 @@ EOM ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"fred"} = "joe" ; - ok(30, checkOutput( "", "fred", "", "joe")) ; + ok(checkOutput("", "fred", "", "joe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(31, $h{"fred"} eq "joe"); - ok(32, checkOutput( "", "fred", "joe", "")) ; + is($h{"fred"}, "joe"); + ok(checkOutput("", "fred", "joe", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(33, $db->FIRSTKEY() eq "fred") ; - ok(34, checkOutput( "fred", "", "", "")) ; + is($db->FIRSTKEY(), "fred"); + ok(checkOutput("fred", "", "", "")); # delete the filters $db->filter_fetch_key (undef); @@ -304,15 +290,15 @@ EOM ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"fred"} = "joe" ; - ok(35, checkOutput( "", "", "", "")) ; + ok(checkOutput("", "", "", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(36, $h{"fred"} eq "joe"); - ok(37, checkOutput( "", "", "", "")) ; + is($h{"fred"}, "joe"); + ok(checkOutput("", "", "", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(38, $db->FIRSTKEY() eq "fred") ; - ok(39, checkOutput( "", "", "", "")) ; + is($db->FIRSTKEY(), "fred"); + ok(checkOutput("", "", "", "")); undef $db ; untie %h; @@ -322,12 +308,11 @@ EOM { # DBM Filter with a closure - use strict ; - use warnings ; my (%h, $db) ; unlink <Op.dbmx*>; - ok(40, $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + $db = tie %h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'ODBM_File'); my %result = () ; @@ -351,32 +336,32 @@ EOM $_ = "original" ; $h{"fred"} = "joe" ; - ok(41, $result{"store key"} eq "store key - 1: [fred]"); - ok(42, $result{"store value"} eq "store value - 1: [joe]"); - ok(43, !defined $result{"fetch key"} ); - ok(44, !defined $result{"fetch value"} ); - ok(45, $_ eq "original") ; - - ok(46, $db->FIRSTKEY() eq "fred") ; - ok(47, $result{"store key"} eq "store key - 1: [fred]"); - ok(48, $result{"store value"} eq "store value - 1: [joe]"); - ok(49, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(50, ! defined $result{"fetch value"} ); - ok(51, $_ eq "original") ; + is($result{"store key"}, "store key - 1: [fred]"); + is($result{"store value"}, "store value - 1: [joe]"); + is($result{"fetch key"}, undef); + is($result{"fetch value"}, undef); + is($_, "original"); + + is($db->FIRSTKEY(), "fred"); + is($result{"store key"}, "store key - 1: [fred]"); + is($result{"store value"}, "store value - 1: [joe]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, undef); + is($_, "original"); $h{"jim"} = "john" ; - ok(52, $result{"store key"} eq "store key - 2: [fred jim]"); - ok(53, $result{"store value"} eq "store value - 2: [joe john]"); - ok(54, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(55, ! defined $result{"fetch value"} ); - ok(56, $_ eq "original") ; - - ok(57, $h{"fred"} eq "joe"); - ok(58, $result{"store key"} eq "store key - 3: [fred jim fred]"); - ok(59, $result{"store value"} eq "store value - 2: [joe john]"); - ok(60, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(61, $result{"fetch value"} eq "fetch value - 1: [joe]"); - ok(62, $_ eq "original") ; + is($result{"store key"}, "store key - 2: [fred jim]"); + is($result{"store value"}, "store value - 2: [joe john]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, undef); + is($_, "original"); + + is($h{"fred"}, "joe"); + is($result{"store key"}, "store key - 3: [fred jim fred]"); + is($result{"store value"}, "store value - 2: [joe john]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, "fetch value - 1: [joe]"); + is($_, "original"); undef $db ; untie %h; @@ -385,17 +370,16 @@ EOM { # DBM Filter recursion detection - use strict ; - use warnings ; my (%h, $db) ; unlink <Op.dbmx*>; - ok(63, $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + $db = tie %h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'ODBM_File'); $db->filter_store_key (sub { $_ = $h{$_} }) ; eval '$h{1} = 1234' ; - ok(64, $@ =~ /^recursion detected in filter_store_key at/ ); + like($@, qr/^recursion detected in filter_store_key at/); undef $db ; untie %h; @@ -407,18 +391,15 @@ EOM # # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - use warnings ; - use strict ; - use ODBM_File ; unlink <Op.dbmx*>; my %h ; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - ok(65, tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + isa_ok(tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640), 'ODBM_File'); $h{ABC} = undef; - ok(66, $a eq "") ; + is($a, ""); untie %h; unlink <Op.dbmx*>; } @@ -430,34 +411,31 @@ EOM # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - use warnings ; - use strict ; - use ODBM_File ; - unlink <Op.dbmx*>; my $bad_key = 0 ; my %h = () ; - ok(67, my $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + my $db = tie %h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'ODBM_File'); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; $h{'Alpha_ABC'} = 2 ; $h{'Alpha_DEF'} = 5 ; - ok(68, $h{'Alpha_ABC'} == 2); - ok(69, $h{'Alpha_DEF'} == 5); + is($h{'Alpha_ABC'}, 2); + is($h{'Alpha_DEF'}, 5); my ($k, $v) = ("",""); while (($k, $v) = each %h) {} - ok(70, $bad_key == 0); + is($bad_key, 0); $bad_key = 0 ; foreach $k (keys %h) {} - ok(71, $bad_key == 0); + is($bad_key, 0); $bad_key = 0 ; foreach $v (values %h) {} - ok(72, $bad_key == 0); + is($bad_key, 0); undef $db ; untie %h ; @@ -468,12 +446,11 @@ EOM { # Check that DBM Filter can cope with read-only $_ - use warnings ; - use strict ; my %h ; unlink <Op.dbmx*>; - ok(73, my $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + my $db = tie %h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'ODBM_File'); $db->filter_fetch_key (sub { }) ; $db->filter_store_key (sub { }) ; @@ -483,10 +460,10 @@ EOM $_ = "original" ; $h{"fred"} = "joe" ; - ok(74, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); eval { grep { $h{$_} } (1, 2, 3) }; - ok (75, ! $@); + is($@, ''); # delete the filters @@ -497,18 +474,18 @@ EOM $h{"fred"} = "joe" ; - ok(76, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); - ok(77, $db->FIRSTKEY() eq "fred") ; + is($db->FIRSTKEY(), "fred"); eval { grep { $h{$_} } (1, 2, 3) }; - ok (78, ! $@); + is($@, ''); undef $db ; untie %h; unlink <Op.dbmx*>; } -exit ; + if ($^O eq 'hpux') { print <<EOM; # diff --git a/ext/SDBM_File/t/sdbm.t b/ext/SDBM_File/t/sdbm.t index 60423d9..3af6a58 100644 --- a/ext/SDBM_File/t/sdbm.t +++ b/ext/SDBM_File/t/sdbm.t @@ -13,44 +13,34 @@ BEGIN { use strict; use warnings; -sub ok -{ - my $no = shift ; - my $result = shift ; - - print "not " unless $result ; - print "ok $no\n" ; -} +use Test::More tests => 81; require SDBM_File; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; -print "1..80\n"; - unlink <Op_dbmx.*>; umask(0); my %h ; -ok(1, tie %h,'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640); +isa_ok(tie(%h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'SDBM_File'); my $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { ($Dfile) = <Op_dbmx.*>; } -if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin') { - print "ok 2 # Skipped: different file permission semantics\n"; -} -else { +SKIP: { + skip "different file permission semantics on $^O", 1 + if $^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin'; my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat($Dfile); - print (($mode & 0777) == ($^O eq 'vos' ? 0750 : 0640) ? "ok 2\n" : "not ok 2\n"); + is($mode & 0777, 0640); } my $i = 0; while (my ($key,$value) = each(%h)) { $i++; } -print (!$i ? "ok 3\n" : "not ok 3\n"); +is($i, 0); $h{'goner1'} = 'snork'; @@ -72,7 +62,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -print (tie(%h,'SDBM_File','Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); +isa_ok(tie(%h, 'SDBM_File', 'Op_dbmx', O_RDWR, 0640), 'SDBM_File'); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -100,7 +90,8 @@ delete $h{'goner3'}; my @keys = keys(%h); my @values = values(%h); -if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";} +is($#keys, 29); +is($#values, 29); while (my ($key,$value) = each(%h)) { if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { @@ -109,30 +100,29 @@ while (my ($key,$value) = each(%h)) { } } -if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";} +is($i, 30); @keys = ('blurfl', keys(%h), 'dyick'); -if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";} +is($#keys, 31); $h{'foo'} = ''; $h{''} = 'bar'; -# check cache overflow and numeric keys and contents my $ok = 1; for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; } for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; } -print ($ok ? "ok 8\n" : "not ok 8\n"); +is($ok, 1, 'check cache overflow and numeric keys and contents'); my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat($Dfile); -print ($size > 0 ? "ok 9\n" : "not ok 9\n"); +cmp_ok($size, '>', 0); @h{0..200} = 200..400; my @foo = @h{0..200}; -print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n"; +is(join(':',200..400), join(':',@foo)); -print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); -print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); +is($h{'foo'}, ''); +is($h{''}, 'bar'); { @@ -140,9 +130,6 @@ print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); package Another ; - use strict ; - use warnings ; - open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; print FILE <<'EOM' ; @@ -186,22 +173,22 @@ EOM BEGIN { push @INC, '.'; } eval 'use SubDB ; use Fcntl ;'; - main::ok(13, $@ eq "") ; + main::is($@, ""); my %h ; my $X ; eval ' $X = tie(%h, "SubDB","dbhash_tmp", O_RDWR|O_CREAT, 0640 ); ' ; - main::ok(14, $@ eq "") ; + main::is($@, ""); my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ; - main::ok(15, $@ eq "") ; - main::ok(16, $ret == 5) ; + main::is($@, ""); + main::is($ret, 5); $ret = eval '$X->A_new_method("fred") ' ; - main::ok(17, $@ eq "") ; - main::ok(18, $ret eq "[[5]]") ; + main::is($@, ""); + main::is($ret, "[[5]]"); undef $X; untie(%h); @@ -209,16 +196,14 @@ EOM } -ok(19, !exists $h{'goner1'}); -ok(20, exists $h{'foo'}); +is(exists $h{goner1}, ''); +is(exists $h{foo}, 1); untie %h; unlink <Op_dbmx*>, $Dfile; { # DBM Filter tests - use strict ; - use warnings ; my (%h, $db) ; my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; @@ -232,7 +217,8 @@ unlink <Op_dbmx*>, $Dfile; } unlink <Op_dbmx*>; - ok(21, $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ; + $db = tie %h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'SDBM_File'); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; $db->filter_store_key (sub { $store_key = $_ }) ; @@ -243,17 +229,17 @@ unlink <Op_dbmx*>, $Dfile; $h{"fred"} = "joe" ; # fk sk fv sv - ok(22, checkOutput( "", "fred", "", "joe")) ; + ok(checkOutput("", "fred", "", "joe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(23, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); # fk sk fv sv - ok(24, checkOutput( "", "fred", "joe", "")) ; + ok(checkOutput("", "fred", "joe", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(25, $db->FIRSTKEY() eq "fred") ; + is($db->FIRSTKEY(), "fred"); # fk sk fv sv - ok(26, checkOutput( "fred", "", "", "")) ; + ok(checkOutput("fred", "", "", "")); # replace the filters, but remember the previous set my ($old_fk) = $db->filter_fetch_key @@ -268,17 +254,17 @@ unlink <Op_dbmx*>, $Dfile; ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"Fred"} = "Joe" ; # fk sk fv sv - ok(27, checkOutput( "", "fred", "", "Jxe")) ; + ok(checkOutput("", "fred", "", "Jxe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(28, $h{"Fred"} eq "[Jxe]"); + is($h{"Fred"}, "[Jxe]"); # fk sk fv sv - ok(29, checkOutput( "", "fred", "[Jxe]", "")) ; + ok(checkOutput("", "fred", "[Jxe]", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(30, $db->FIRSTKEY() eq "FRED") ; + is($db->FIRSTKEY(), "FRED"); # fk sk fv sv - ok(31, checkOutput( "FRED", "", "", "")) ; + ok(checkOutput("FRED", "", "", "")); # put the original filters back $db->filter_fetch_key ($old_fk); @@ -288,15 +274,15 @@ unlink <Op_dbmx*>, $Dfile; ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"fred"} = "joe" ; - ok(32, checkOutput( "", "fred", "", "joe")) ; + ok(checkOutput("", "fred", "", "joe")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(33, $h{"fred"} eq "joe"); - ok(34, checkOutput( "", "fred", "joe", "")) ; + is($h{"fred"}, "joe"); + ok(checkOutput("", "fred", "joe", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(35, $db->FIRSTKEY() eq "fred") ; - ok(36, checkOutput( "fred", "", "", "")) ; + is($db->FIRSTKEY(), "fred"); + ok(checkOutput("fred", "", "", "")); # delete the filters $db->filter_fetch_key (undef); @@ -306,15 +292,15 @@ unlink <Op_dbmx*>, $Dfile; ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; $h{"fred"} = "joe" ; - ok(37, checkOutput( "", "", "", "")) ; + ok(checkOutput("", "", "", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(38, $h{"fred"} eq "joe"); - ok(39, checkOutput( "", "", "", "")) ; + is($h{"fred"}, "joe"); + ok(checkOutput("", "", "", "")); ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; - ok(40, $db->FIRSTKEY() eq "fred") ; - ok(41, checkOutput( "", "", "", "")) ; + is($db->FIRSTKEY(), "fred"); + ok(checkOutput("", "", "", "")); undef $db ; untie %h; @@ -324,12 +310,11 @@ unlink <Op_dbmx*>, $Dfile; { # DBM Filter with a closure - use strict ; - use warnings ; my (%h, $db) ; unlink <Op_dbmx*>; - ok(42, $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ; + $db = tie %h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'SDBM_File'); my %result = () ; @@ -353,32 +338,32 @@ unlink <Op_dbmx*>, $Dfile; $_ = "original" ; $h{"fred"} = "joe" ; - ok(43, $result{"store key"} eq "store key - 1: [fred]"); - ok(44, $result{"store value"} eq "store value - 1: [joe]"); - ok(45, !defined $result{"fetch key"} ); - ok(46, !defined $result{"fetch value"} ); - ok(47, $_ eq "original") ; - - ok(48, $db->FIRSTKEY() eq "fred") ; - ok(49, $result{"store key"} eq "store key - 1: [fred]"); - ok(50, $result{"store value"} eq "store value - 1: [joe]"); - ok(51, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(52, ! defined $result{"fetch value"} ); - ok(53, $_ eq "original") ; + is($result{"store key"}, "store key - 1: [fred]"); + is($result{"store value"}, "store value - 1: [joe]"); + is($result{"fetch key"}, undef); + is($result{"fetch value"}, undef); + is($_, "original"); + + is($db->FIRSTKEY(), "fred"); + is($result{"store key"}, "store key - 1: [fred]"); + is($result{"store value"}, "store value - 1: [joe]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, undef); + is($_, "original"); $h{"jim"} = "john" ; - ok(54, $result{"store key"} eq "store key - 2: [fred jim]"); - ok(55, $result{"store value"} eq "store value - 2: [joe john]"); - ok(56, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(57, ! defined $result{"fetch value"} ); - ok(58, $_ eq "original") ; - - ok(59, $h{"fred"} eq "joe"); - ok(60, $result{"store key"} eq "store key - 3: [fred jim fred]"); - ok(61, $result{"store value"} eq "store value - 2: [joe john]"); - ok(62, $result{"fetch key"} eq "fetch key - 1: [fred]"); - ok(63, $result{"fetch value"} eq "fetch value - 1: [joe]"); - ok(64, $_ eq "original") ; + is($result{"store key"}, "store key - 2: [fred jim]"); + is($result{"store value"}, "store value - 2: [joe john]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, undef); + is($_, "original"); + + is($h{"fred"}, "joe"); + is($result{"store key"}, "store key - 3: [fred jim fred]"); + is($result{"store value"}, "store value - 2: [joe john]"); + is($result{"fetch key"}, "fetch key - 1: [fred]"); + is($result{"fetch value"}, "fetch value - 1: [joe]"); + is($_, "original"); undef $db ; untie %h; @@ -387,17 +372,16 @@ unlink <Op_dbmx*>, $Dfile; { # DBM Filter recursion detection - use strict ; - use warnings ; my (%h, $db) ; unlink <Op_dbmx*>; - ok(65, $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ; + $db = tie %h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'SDBM_File'); $db->filter_store_key (sub { $_ = $h{$_} }) ; eval '$h{1} = 1234' ; - ok(66, $@ =~ /^recursion detected in filter_store_key at/ ); + like($@, qr/^recursion detected in filter_store_key at/); undef $db ; untie %h; @@ -409,19 +393,15 @@ unlink <Op_dbmx*>, $Dfile; # # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - use warnings ; - use strict ; - use SDBM_File ; unlink <Op_dbmx*>; my %h ; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - ok(67, tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ; + isa_ok(tie(%h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'SDBM_File'); $h{ABC} = undef; - ok(68, $a eq "") ; - + is($a, ""); untie %h; unlink <Op_dbmx*>; } @@ -433,34 +413,31 @@ unlink <Op_dbmx*>, $Dfile; # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - use warnings ; - use strict ; - use SDBM_File ; - unlink <Op_dbmx*>; my $bad_key = 0 ; my %h = () ; - ok(69, my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ; + my $db = tie %h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'SDBM_File'); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; $h{'Alpha_ABC'} = 2 ; $h{'Alpha_DEF'} = 5 ; - ok(70, $h{'Alpha_ABC'} == 2); - ok(71, $h{'Alpha_DEF'} == 5); + is($h{'Alpha_ABC'}, 2); + is($h{'Alpha_DEF'}, 5); my ($k, $v) = ("",""); while (($k, $v) = each %h) {} - ok(72, $bad_key == 0); + is($bad_key, 0); $bad_key = 0 ; foreach $k (keys %h) {} - ok(73, $bad_key == 0); + is($bad_key, 0); $bad_key = 0 ; foreach $v (values %h) {} - ok(74, $bad_key == 0); + is($bad_key, 0); undef $db ; untie %h ; @@ -471,12 +448,11 @@ unlink <Op_dbmx*>, $Dfile; { # 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)) ; + my $db = tie %h, 'SDBM_File', 'Op1_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, 'SDBM_File'); $db->filter_fetch_key (sub { }) ; $db->filter_store_key (sub { }) ; @@ -486,10 +462,10 @@ unlink <Op_dbmx*>, $Dfile; $_ = "original" ; $h{"fred"} = "joe" ; - ok(76, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); - eval { map { $h{$_} } (1, 2, 3) }; - ok (77, ! $@); + eval { grep { $h{$_} } (1, 2, 3) }; + is($@, ''); # delete the filters @@ -500,15 +476,14 @@ unlink <Op_dbmx*>, $Dfile; $h{"fred"} = "joe" ; - ok(78, $h{"fred"} eq "joe"); + is($h{"fred"}, "joe"); - ok(79, $db->FIRSTKEY() eq "fred") ; + is($db->FIRSTKEY(), "fred"); eval { map { $h{$_} } (1, 2, 3) }; - ok (80, ! $@); + is($@, ''); undef $db ; untie %h; unlink <Op1_dbmx*>; } -exit ; -- Perl5 Master Repository
