From 3fb31b78f4283130010f7c6a6d192dc57df4b0b8 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Thu, 16 Dec 2010 14:09:42 +0000 Subject: [PATCH] Converge ext/[GNOS]DBM_File/t/[gnos]dbm.t by parameterising the class name. --- ext/GDBM_File/t/gdbm.t | 48 +++++++++++++++++++++++++++--------------------- ext/NDBM_File/t/ndbm.t | 50 ++++++++++++++++++++++++++++---------------------- ext/ODBM_File/t/odbm.t | 50 ++++++++++++++++++++++++++++---------------------- ext/SDBM_File/t/sdbm.t | 48 +++++++++++++++++++++++++++--------------------- 4 files changed, 110 insertions(+), 86 deletions(-) diff --git a/ext/GDBM_File/t/gdbm.t b/ext/GDBM_File/t/gdbm.t index 680b67f..a071dd7 100644 --- a/ext/GDBM_File/t/gdbm.t +++ b/ext/GDBM_File/t/gdbm.t @@ -2,10 +2,16 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ +our $DBM_Class; + +BEGIN { + $DBM_Class = 'GDBM_File'; +} + BEGIN { require Config; import Config; - if ($Config{'extensions'} !~ /\bGDBM_File\b/) { - print "1..0 # Skip: GDBM_File was not built\n"; + if ($Config{'extensions'} !~ /\b$DBM_Class\b/) { + print "1..0 # Skip: $DBM_Class was not built\n"; exit 0; } } @@ -13,14 +19,14 @@ BEGIN { use strict; use warnings; -use Test::More tests => 83; -use GDBM_File; +use Test::More tests => 84; +BEGIN {use_ok($DBM_Class)}; unlink ; umask(0); my %h ; -isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); +isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', GDBM_WRCREAT, 0640), $DBM_Class); my $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { @@ -59,7 +65,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRITER, 0640), 'GDBM_File'); +isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', GDBM_WRITER, 0640), $DBM_Class); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -130,7 +136,7 @@ unlink , $Dfile; package Another ; open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; - print FILE <<'EOM' ; + printf FILE <<'EOM', $DBM_Class, $DBM_Class, $DBM_Class; package SubDB ; @@ -139,9 +145,9 @@ unlink , $Dfile; use vars qw(@ISA @EXPORT) ; require Exporter ; - use GDBM_File; - @ISA=qw(GDBM_File); - @EXPORT = @GDBM_File::EXPORT ; + use %s; + @ISA=qw(%s); + @EXPORT = @%s::EXPORT ; sub STORE { my $self = shift ; @@ -218,8 +224,8 @@ unlink , $Dfile; } unlink ; - $db = tie %h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640; - isa_ok($db, 'GDBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; $db->filter_store_key (sub { $store_key = $_ }) ; @@ -314,8 +320,8 @@ unlink , $Dfile; my (%h, $db) ; unlink ; - $db = tie %h, 'GDBM_File','Op_dbmx', GDBM_WRCREAT, 0640; - isa_ok($db, 'GDBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, $DBM_Class); my %result = () ; @@ -376,8 +382,8 @@ unlink , $Dfile; my (%h, $db) ; unlink ; - $db = tie %h, 'GDBM_File','Op_dbmx', GDBM_WRCREAT, 0640; - isa_ok($db, 'GDBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_store_key (sub { $_ = $h{$_} }) ; @@ -400,7 +406,7 @@ unlink , $Dfile; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); + isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', GDBM_WRCREAT, 0640), $DBM_Class); $h{ABC} = undef; is($a, ""); untie %h; @@ -417,8 +423,8 @@ unlink , $Dfile; unlink ; my $bad_key = 0 ; my %h = () ; - my $db = tie %h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640; - isa_ok($db, 'GDBM_File'); + my $db = tie %h, $DBM_Class, 'Op_dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; @@ -451,8 +457,8 @@ unlink , $Dfile; my %h ; unlink ; - my $db = tie %h, 'GDBM_File', 'Op1_dbmx', GDBM_WRCREAT, 0640; - isa_ok($db, 'GDBM_File'); + my $db = tie %h, $DBM_Class, 'Op1_dbmx', GDBM_WRCREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { }) ; $db->filter_store_key (sub { }) ; diff --git a/ext/NDBM_File/t/ndbm.t b/ext/NDBM_File/t/ndbm.t index 03b78c4..fb132f3 100644 --- a/ext/NDBM_File/t/ndbm.t +++ b/ext/NDBM_File/t/ndbm.t @@ -2,10 +2,16 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ +our $DBM_Class; + +BEGIN { + $DBM_Class = 'NDBM_File'; +} + BEGIN { require Config; import Config; - if ($Config{'extensions'} !~ /\bNDBM_File\b/) { - print "1..0 # Skip: NDBM_File was not built\n"; + if ($Config{'extensions'} !~ /\b$DBM_Class\b/) { + print "1..0 # Skip: $DBM_Class was not built\n"; exit 0; } } @@ -13,17 +19,17 @@ BEGIN { use strict; use warnings; -use Test::More tests => 81; +use Test::More tests => 82; -require NDBM_File; +BEGIN {use_ok($DBM_Class)}; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; unlink ; umask(0); -my %h; -isa_ok(tie(%h,'NDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640), 'NDBM_File'); +my %h ; +isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640), $DBM_Class); my $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { @@ -62,7 +68,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -isa_ok(tie(%h,'NDBM_File','Op_dbmx', O_RDWR, 0640), 'NDBM_File'); +isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', O_RDWR, 0640), $DBM_Class); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -133,7 +139,7 @@ unlink , $Dfile; package Another ; open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; - print FILE <<'EOM' ; + printf FILE <<'EOM', $DBM_Class, $DBM_Class, $DBM_Class; package SubDB ; @@ -142,9 +148,9 @@ unlink , $Dfile; use vars qw(@ISA @EXPORT) ; require Exporter ; - use NDBM_File; - @ISA=qw(NDBM_File); - @EXPORT = @NDBM_File::EXPORT ; + use %s; + @ISA=qw(%s); + @EXPORT = @%s::EXPORT ; sub STORE { my $self = shift ; @@ -217,8 +223,8 @@ unlink , $Dfile; } unlink ; - $db = tie %h, 'NDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'NDBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; $db->filter_store_key (sub { $store_key = $_ }) ; @@ -313,8 +319,8 @@ unlink , $Dfile; my (%h, $db) ; unlink ; - $db = tie %h, 'NDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'NDBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); my %result = () ; @@ -375,8 +381,8 @@ unlink , $Dfile; my (%h, $db) ; unlink ; - $db = tie %h, 'NDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'NDBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_store_key (sub { $_ = $h{$_} }) ; @@ -399,7 +405,7 @@ unlink , $Dfile; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - isa_ok(tie(%h, 'NDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640), 'NDBM_File'); + isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640), $DBM_Class); $h{ABC} = undef; is($a, ""); untie %h; @@ -416,8 +422,8 @@ unlink , $Dfile; unlink ; my $bad_key = 0 ; my %h = () ; - my $db = tie %h, 'NDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'NDBM_File'); + my $db = tie %h, $DBM_Class,'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; @@ -450,8 +456,8 @@ unlink , $Dfile; my %h ; unlink ; - my $db = tie %h, 'NDBM_File','Op1_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'NDBM_File'); + my $db = tie %h, $DBM_Class, 'Op1_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { }) ; $db->filter_store_key (sub { }) ; diff --git a/ext/ODBM_File/t/odbm.t b/ext/ODBM_File/t/odbm.t index 6416ad1..86072fd 100644 --- a/ext/ODBM_File/t/odbm.t +++ b/ext/ODBM_File/t/odbm.t @@ -2,10 +2,16 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ +our $DBM_Class; + +BEGIN { + $DBM_Class = 'ODBM_File'; +} + BEGIN { require Config; import Config; - if ($Config{'extensions'} !~ /\bODBM_File\b/ or $Config{'d_cplusplus'}) { - print "1..0 # Skip: ODBM_File was not built\n"; + if ($Config{'extensions'} !~ /\b$DBM_Class\b/ or $Config{'d_cplusplus'}) { + print "1..0 # Skip: $DBM_Class was not built\n"; exit 0; } } @@ -13,17 +19,17 @@ BEGIN { use strict; use warnings; -use Test::More tests => 81; +use Test::More tests => 82; -require ODBM_File; +BEGIN {use_ok($DBM_Class)}; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; unlink ; umask(0); -my %h; -isa_ok(tie(%h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'ODBM_File'); +my %h ; +isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640), $DBM_Class); my $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { @@ -62,7 +68,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -isa_ok(tie(%h, 'ODBM_File', 'Op_dbmx', O_RDWR, 0640), 'ODBM_File'); +isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', O_RDWR, 0640), $DBM_Class); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -133,7 +139,7 @@ unlink , $Dfile; package Another ; open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; - print FILE <<'EOM' ; + printf FILE <<'EOM', $DBM_Class, $DBM_Class, $DBM_Class; package SubDB ; @@ -142,9 +148,9 @@ unlink , $Dfile; use vars qw(@ISA @EXPORT) ; require Exporter ; - use ODBM_File; - @ISA=qw(ODBM_File); - @EXPORT = @ODBM_File::EXPORT ; + use %s; + @ISA=qw(%s); + @EXPORT = @%s::EXPORT ; sub STORE { my $self = shift ; @@ -217,8 +223,8 @@ unlink , $Dfile; } unlink ; - $db = tie %h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'ODBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; $db->filter_store_key (sub { $store_key = $_ }) ; @@ -313,8 +319,8 @@ unlink , $Dfile; my (%h, $db) ; unlink ; - $db = tie %h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'ODBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); my %result = () ; @@ -375,8 +381,8 @@ unlink , $Dfile; my (%h, $db) ; unlink ; - $db = tie %h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'ODBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_store_key (sub { $_ = $h{$_} }) ; @@ -399,7 +405,7 @@ unlink , $Dfile; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - isa_ok(tie(%h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'ODBM_File'); + isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640), $DBM_Class); $h{ABC} = undef; is($a, ""); untie %h; @@ -416,8 +422,8 @@ unlink , $Dfile; unlink ; my $bad_key = 0 ; my %h = () ; - my $db = tie %h, 'ODBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'ODBM_File'); + my $db = tie %h, $DBM_Class,'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; @@ -450,8 +456,8 @@ unlink , $Dfile; my %h ; unlink ; - my $db = tie %h, 'ODBM_File','Op1_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'ODBM_File'); + my $db = tie %h, $DBM_Class, 'Op1_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { }) ; $db->filter_store_key (sub { }) ; diff --git a/ext/SDBM_File/t/sdbm.t b/ext/SDBM_File/t/sdbm.t index cfc67b1..abc30a0 100644 --- a/ext/SDBM_File/t/sdbm.t +++ b/ext/SDBM_File/t/sdbm.t @@ -2,10 +2,16 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ +our $DBM_Class; + +BEGIN { + $DBM_Class = 'SDBM_File'; +} + BEGIN { require Config; import Config; - if ($Config{'extensions'} !~ /\bSDBM_File\b/) { - print "1..0 # Skip: no SDBM_File\n"; + if ($Config{'extensions'} !~ /\b$DBM_Class\b/) { + print "1..0 # Skip: $DBM_Class was not built\n"; exit 0; } } @@ -13,9 +19,9 @@ BEGIN { use strict; use warnings; -use Test::More tests => 83; +use Test::More tests => 84; -require SDBM_File; +BEGIN {use_ok($DBM_Class)}; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; @@ -23,7 +29,7 @@ unlink ; umask(0); my %h ; -isa_ok(tie(%h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'SDBM_File'); +isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640), $DBM_Class); my $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { @@ -62,7 +68,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -isa_ok(tie(%h, 'SDBM_File', 'Op_dbmx', O_RDWR, 0640), 'SDBM_File'); +isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', O_RDWR, 0640), $DBM_Class); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -136,7 +142,7 @@ unlink , $Dfile; package Another ; open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; - print FILE <<'EOM' ; + printf FILE <<'EOM', $DBM_Class, $DBM_Class, $DBM_Class; package SubDB ; @@ -145,9 +151,9 @@ unlink , $Dfile; use vars qw(@ISA @EXPORT) ; require Exporter ; - use SDBM_File; - @ISA=qw(SDBM_File); - @EXPORT = @SDBM_File::EXPORT ; + use %s; + @ISA=qw(%s); + @EXPORT = @%s::EXPORT ; sub STORE { my $self = shift ; @@ -220,8 +226,8 @@ unlink , $Dfile; } unlink ; - $db = tie %h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'SDBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; $db->filter_store_key (sub { $store_key = $_ }) ; @@ -316,8 +322,8 @@ unlink , $Dfile; my (%h, $db) ; unlink ; - $db = tie %h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'SDBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); my %result = () ; @@ -378,8 +384,8 @@ unlink , $Dfile; my (%h, $db) ; unlink ; - $db = tie %h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'SDBM_File'); + $db = tie %h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_store_key (sub { $_ = $h{$_} }) ; @@ -402,7 +408,7 @@ unlink , $Dfile; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - isa_ok(tie(%h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'SDBM_File'); + isa_ok(tie(%h, $DBM_Class, 'Op_dbmx', O_RDWR|O_CREAT, 0640), $DBM_Class); $h{ABC} = undef; is($a, ""); untie %h; @@ -419,8 +425,8 @@ unlink , $Dfile; unlink ; my $bad_key = 0 ; my %h = () ; - my $db = tie %h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'SDBM_File'); + my $db = tie %h, $DBM_Class,'Op_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; @@ -453,8 +459,8 @@ unlink , $Dfile; my %h ; unlink ; - my $db = tie %h, 'SDBM_File', 'Op1_dbmx', O_RDWR|O_CREAT, 0640; - isa_ok($db, 'SDBM_File'); + my $db = tie %h, $DBM_Class, 'Op1_dbmx', O_RDWR|O_CREAT, 0640; + isa_ok($db, $DBM_Class); $db->filter_fetch_key (sub { }) ; $db->filter_store_key (sub { }) ; -- 2.7.4