[svn:dbi] r13961 - in dbi/trunk: . lib/DBI t

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)),