Author: REHSACK
Date: Fri May 7 07:48:25 2010
New Revision: 13961
Modified:
dbi/trunk/Makefile.PL
dbi/trunk/lib/DBI/DBD.pm
dbi/trunk/t/50dbm.t
dbi/trunk/t/85gofer.t
Log:
enable DBD::DBM and DBD::Gofer are tested with SQL::Statement (when
available) and DBI::SQL::Nano
Modified: dbi/trunk/Makefile.PL
==============================================================================
--- dbi/trunk/Makefile.PL (original)
+++ dbi/trunk/Makefile.PL Fri May 7 07:48:25 2010
@@ -159,6 +159,7 @@
WriteMakefile(
dbd_edit_mm_attribs(\%opts, {
create_pp_tests => 1,
+ create_nano_tests => 1,
})
);
# WriteMakefile call is last thing executed
Modified: dbi/trunk/lib/DBI/DBD.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD.pm (original)
+++ dbi/trunk/lib/DBI/DBD.pm Fri May 7 07:48:25 2010
@@ -3320,31 +3320,41 @@
if @_;
_inst_checks();
+ # what can be done
+ my %test_variants = (
+ p => { name => "DBI::PurePerl",
+ match => qr/^\d/,
+ add => [ '$ENV{DBI_PUREPERL} = 2' ],
+ },
+ g => { name => "DBD::Gofer",
+ match => qr/^\d/,
+ add => [ q{$ENV{DBI_AUTOPROXY} =
'dbi:Gofer:transport=null;policy=pedantic'} ],
+ },
+ xgp => { name => "PurePerl & Gofer",
+ match => qr/^\d/,
+ add => [ q{$ENV{DBI_PUREPERL} = 2; $ENV{DBI_AUTOPROXY} =
'dbi:Gofer:transport=null;policy=pedantic'} ],
+ },
+ n => { name => "DBI::SQL::Nano",
+ match => qr/^(50dbm|85gofer)\.t$/,
+ add => [ q{$ENV{DBI_SQL_NANO} = 1; # force use of
DBI::SQL::Nano} ],
+ },
+ # mx => { name => "DBD::Multiplex",
+ # add => [ q{local $ENV{DBI_AUTOPROXY} = 'dbi:Multiplex:';}
],
+ # }
+ # px => { name => "DBD::Proxy",
+ # need mechanism for starting/stopping the proxy server
+ # add => [ q{local $ENV{DBI_AUTOPROXY} = 'dbi:Proxy:XXX';} ],
+ # }
+ );
+
# decide what needs doing
+ $dbd_attr->{create_pp_tests} or delete @test_variants{'p','q','xqp'};
+ $dbd_attr->{create_nano_tests} or delete $test_variants{n};
# do whatever needs doing
- if ($dbd_attr->{create_pp_tests}) {
+ if( keys %test_variants ) {
# XXX need to convert this to work within the generated Makefile
# so 'make' creates them and 'make clean' deletes them
- my %test_variants = (
- p => { name => "DBI::PurePerl",
- add => [ '$ENV{DBI_PUREPERL} = 2' ],
- },
- g => { name => "DBD::Gofer",
- add => [ q{$ENV{DBI_AUTOPROXY} =
'dbi:Gofer:transport=null;policy=pedantic'} ],
- },
- xgp => { name => "PurePerl & Gofer",
- add => [ q{$ENV{DBI_PUREPERL} = 2; $ENV{DBI_AUTOPROXY}
= 'dbi:Gofer:transport=null;policy=pedantic'} ],
- },
- # mx => { name => "DBD::Multiplex",
- # add => [ q{local $ENV{DBI_AUTOPROXY} =
'dbi:Multiplex:';} ],
- # }
- # px => { name => "DBD::Proxy",
- # need mechanism for starting/stopping the proxy server
- # add => [ q{local $ENV{DBI_AUTOPROXY} =
'dbi:Proxy:XXX';} ],
- # }
- );
-
opendir DIR, 't' or die "Can't read 't' directory: $!";
my @tests = grep { /\.t$/ } readdir DIR;
closedir DIR;
@@ -3353,7 +3363,7 @@
printf "Creating test wrappers for $v_info->{name}:\n";
foreach my $test (sort @tests) {
- next if $test !~ /^\d/;
+ next if $test !~ $v_info->{match};
my $usethr = ($test =~ /(\d+|\b)thr/ && $] >= 5.008 &&
$Config{useithreads});
my $v_test = "t/zv${v_type}_$test";
my $v_perl = ($test =~ /taint/) ? "perl -wT" : "perl -w";
Modified: dbi/trunk/t/50dbm.t
==============================================================================
--- dbi/trunk/t/50dbm.t (original)
+++ dbi/trunk/t/50dbm.t Fri May 7 07:48:25 2010
@@ -21,7 +21,8 @@
# 0=SQL::Statement if avail, 1=DBI::SQL::Nano
# next line forces use of Nano rather than default behaviour
- $ENV{DBI_SQL_NANO}=1;
+ # $ENV{DBI_SQL_NANO}=1;
+ # This is done in zvn_50dbm.t
push @mldbm_types, '';
if (eval { require 'MLDBM.pm'; }) {
@@ -155,14 +156,15 @@
5 => '15',
} if $mldbm;
- print " $sql\n";
+ print " $sql ...";
$sql =~ s/\s*;\s*(?:#(.*))//;
my $comment = $1;
my $sth = $dbh->prepare($sql) or die $dbh->errstr;
my @bind;
@bind = split /,/, $comment if $sth->{NUM_OF_PARAMS};
- $sth->execute(@bind);
+ my $n = $sth->execute(@bind);
+ print " $n\n";
die $sth->errstr if $sth->err and $sql !~ /DROP/;
next unless $sql =~ /SELECT/;
@@ -187,8 +189,8 @@
INSERT INTO fruit VALUES (3, NULL );
INSERT INTO fruit VALUES (4,'to delete' );
INSERT INTO fruit VALUES (?,?); #5,via placeholders
-UPDATE fruit SET dVal='apples' WHERE dKey=2;
DELETE FROM fruit WHERE dVal='to delete';
+UPDATE fruit SET dVal='apples' WHERE dKey=2;
SELECT * FROM fruit;
DROP TABLE fruit;
Modified: dbi/trunk/t/85gofer.t
==============================================================================
--- dbi/trunk/t/85gofer.t (original)
+++ dbi/trunk/t/85gofer.t Fri May 7 07:48:25 2010
@@ -22,7 +22,8 @@
# 0=SQL::Statement if avail, 1=DBI::SQL::Nano
# next line forces use of Nano rather than default behaviour
-$ENV{DBI_SQL_NANO}=1;
+# $ENV{DBI_SQL_NANO}=1;
+# This is done in zvn_50dbm.t
GetOptions(
'c|count=i' => \(my $opt_count = (-t STDOUT ? 100 : 0)),
