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;
>
