Re: Patch to allow tests with SQL::Statement for DBD::DBM and DBD::Gofer

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