Author: timbo
Date: Fri Mar 12 05:15:12 2004
New Revision: 221
Modified:
dbi/trunk/lib/DBD/DBM.pm
dbi/trunk/lib/DBD/File.pm
dbi/trunk/t/50dbm.t
Log:
Only use SDBM_File to test DBD::DBM by default.
Minor tidy-ups for DBD::DBM/DBD::File code
Modified: dbi/trunk/lib/DBD/DBM.pm
==============================================================================
--- dbi/trunk/lib/DBD/DBM.pm (original)
+++ dbi/trunk/lib/DBD/DBM.pm Fri Mar 12 05:15:12 2004
@@ -184,7 +184,7 @@
#
if ( $attrib ne 'dbm_valid_attrs' # gotta start somewhere :-)
and !$dbh->{dbm_valid_attrs}->{$attrib} ) {
- return $dbh->set_err( 1,"Invalid attribute '$attrib'!");
+ return $dbh->set_err( 1,"Invalid attribute '$attrib'");
}
else {
@@ -325,15 +325,9 @@
# could replace this by trying to open the file in non-create mode
# first and dieing if that succeeds.
# Currently this test doesn't work where NDBM is actually Berkeley (.db)
- die "Cannot CREATE '$file$ext', already exists!"
+ die "Cannot CREATE '$file$ext' because it already exists"
if $createMode and (-e "$file$ext");
- # let tie() fail instead of this explicit test
- #die "Cannot open '$file$ext', file not found!"
- # if !$createMode
- # and !($self->{command} eq 'DROP')
- # and !(-e "$file$ext");
-
# LOCKING
#
my($nolock,$lockext,$lock_table);
@@ -350,9 +344,9 @@
# open and flock the lockfile, creating it if necessary
#
if (!$nolock) {
- $lock_table = $self->DBD::File::Statement::open_table(
+ $lock_table = $self->SUPER::open_table(
$data, "$table$lockext", $createMode, $lockMode
- ) or die "Couldn't open lockfile '$table$lockext'!\n";
+ );
}
# TIEING
Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm (original)
+++ dbi/trunk/lib/DBD/File.pm Fri Mar 12 05:15:12 2004
@@ -234,14 +234,14 @@
# if ( !$dbh->{f_valid_attrs}->{$attrib}
# and !$dbh->{sql_valid_attrs}->{$attrib}
# ) {
- # return $dbh->set_err( 1,"Invalid attribute '$attrib'!");
+ # return $dbh->set_err( 1,"Invalid attribute '$attrib'");
# }
# else {
# $dbh->{$attrib} = $value;
# }
if ($attrib eq 'f_dir') {
- return $dbh->set_err( 1,"No such directory '$value'!")
+ return $dbh->set_err( 1,"No such directory '$value'")
unless -d $value;
}
$dbh->{$attrib} = $value;
Modified: dbi/trunk/t/50dbm.t
==============================================================================
--- dbi/trunk/t/50dbm.t (original)
+++ dbi/trunk/t/50dbm.t Fri Mar 12 05:15:12 2004
@@ -12,14 +12,6 @@
# We don't want to be tripped up by a badly installed module
# so we remove from @INC any version-specific dirs that don't
# also have an arch-specific dir. Plus, for 5.8 remove any <=5.7
- my %inc = map { $_ => 1 } @INC;
- my @del = grep {
- m:/5\.[0-9.]+$: && !$inc{"$_/$Config{archname}"}
- or m:/5\.[0-7]: && $] >= 5.8
- } @INC;
- my %del = map { $_ => 1 } @del;
- @INC = grep { !$del{$_} } @INC;
- print "Removed some old dirs from [EMAIL PROTECTED] for this test: @del\n" if
@del;
# 0=SQL::Statement if avail, 1=DBI::SQL::Nano
# next line forces use of Nano rather than default behaviour
@@ -30,12 +22,24 @@
push @mldbm_types, 'Storable' if eval { require 'Storable.pm' };
}
- # test with as many of the 5 major DBM types as are available
- #
- for (qw( SDBM_File GDBM_File NDBM_File ODBM_File DB_File BerkeleyDB )){
- eval { require "$_.pm" };
- push @dbm_types, $_ unless $@;
+ if ("@ARGV" eq "all") {
+ # test with as many of the 5 major DBM types as are available
+ for (qw( SDBM_File GDBM_File NDBM_File ODBM_File DB_File BerkeleyDB )){
+ push @dbm_types, $_ if eval { require "$_.pm" };
+ }
}
+ elsif (@ARGV) {
+ @dbm_types = @ARGV;
+ }
+ else {
+ # we only test SDBM_File by default to avoid tripping up
+ # on any broken DBM's that may be installed in odd places.
+ # It's only DBD::DBM we're trying to test here.
+ @dbm_types = ("SDBM_File");
+ }
+
+ print "Using DBM modules: @dbm_types\n";
+ print "Using MLDBM serializers: @mldbm_types\n" if @mldbm_types;
my $num_tests = ([EMAIL PROTECTED]) * @dbm_types * 11;
if (!$num_tests) {
