It would be nice to also get coverage of the nano + DBI::PurePerl case.
Tim.
On Fri, May 07, 2010 at 02:18:46PM +0200, Jens Rehsack wrote:
Hi,
as requested, I'd like to allow tests against SQL::Statement for those
DBD's which support it, too.
If no one has objections, I'd like to commit attached patch.
Best regards,
Jens
Index: lib/DBI/DBD.pm
===
--- lib/DBI/DBD.pm(revision 13946)
+++ lib/DBI/DBD.pm(working copy)
@@ -3320,20 +3320,25 @@
if @_;
_inst_checks();
+my %test_variants;
+
# decide what needs doing
# do whatever needs doing
if ($dbd_attr-{create_pp_tests}) {
# XXX need to convert this to work within the generated Makefile
# so 'make' creates them and 'make clean' deletes them
- my %test_variants = (
+ %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'} ],
},
# mx = { name = DBD::Multiplex,
@@ -3344,7 +3349,17 @@
# add = [ q{local $ENV{DBI_AUTOPROXY} =
'dbi:Proxy:XXX';} ],
# }
);
+}
+if ($dbd_attr-{create_nano_tests}) {
+ $test_variants{n} = {
+ name = DBI::SQL::Nano,
+ match = qr/^(50dbm|85gofer)\.t$/,
+ add = [ q{$ENV{DBI_SQL_NANO} = 1; # force use of DBI::SQL::Nano} ],
+ };
+}
+
+if( 0 != scalar keys %test_variants ) {
opendir DIR, 't' or die Can't read 't' directory: $!;
my @tests = grep { /\.t$/ } readdir DIR;
closedir DIR;
@@ -3353,7 +3368,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;
Index: Makefile.PL
===
--- Makefile.PL (revision 13946)
+++ Makefile.PL (working copy)
@@ -159,6 +159,7 @@
WriteMakefile(
dbd_edit_mm_attribs(\%opts, {
create_pp_tests = 1,
+ create_nano_tests = 1,
})
);
# WriteMakefile call is last thing executed
Index: t/85gofer.t
===
--- t/85gofer.t (revision 13946)
+++ t/85gofer.t (working copy)
@@ -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)),
Index: t/50dbm.t
===
--- t/50dbm.t (revision 13946)
+++ t/50dbm.t (working copy)
@@ -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
+DELETE FROM fruit WHERE dVal='to delete';
UPDATE fruit SET dVal='apples' WHERE dKey=2;
-DELETE FROM fruit WHERE dVal='to delete';
SELECT * FROM fruit;
DROP TABLE fruit;
