Patch to allow tests with SQL::Statement for DBD::DBM and DBD::Gofer
Jens Rehsack <[email protected]>
| Newsgroups | gmane.comp.lang.perl.modules.dbi.sybase.devel |
|---|---|
| Message-ID | <[email protected]> |
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
DBI-test-SS.patch
(application/octet-stream, 3.9 KB)
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;