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

Author: REHSACK
Date: Mon May 17 08:22:33 2010
New Revision: 13995

Added:
   dbi/trunk/t/50dbm_simple.t
      - copied unchanged from r13994, /dbi/trunk/t/50dbm.t
Removed:
   dbi/trunk/t/50dbm.t
Modified:
   dbi/trunk/MANIFEST
   dbi/trunk/Makefile.PL
   dbi/trunk/lib/DBI/DBD.pm

Log:
- rename 50dbm.t -> 50dbm_simple.t
- update dbd_edit_mm_attribs() to capture all test scenarios


Modified: dbi/trunk/MANIFEST
==============================================================================
--- dbi/trunk/MANIFEST	(original)
+++ dbi/trunk/MANIFEST	Mon May 17 08:22:33 2010
@@ -90,7 +90,7 @@
 t/41prof_dump.t
 t/42prof_data.t
 t/43prof_env.t
-t/50dbm.t
+t/50dbm_simple.t
 t/60preparse.t
 t/65transact.t
 t/70callbacks.t

Modified: dbi/trunk/Makefile.PL
==============================================================================
--- dbi/trunk/Makefile.PL	(original)
+++ dbi/trunk/Makefile.PL	Mon May 17 08:22:33 2010
@@ -160,6 +160,7 @@
     dbd_edit_mm_attribs(\%opts, {
 	create_pp_tests => 1,
 	create_nano_tests => 1,
+	create_gap_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	Mon May 17 08:22:33 2010
@@ -3323,23 +3323,19 @@
     # what can be done
     my %test_variants = (
 	p => {	name => "DBI::PurePerl",
-		    match => qr/^\d/,
-		    add => [ '$ENV{DBI_PUREPERL} = 2' ],
+		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'} ],
+		match => qr/^\d/,
+		add => [ q{$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} ],
+		match => qr/^(?:5\ddbm_\w+|85gofer)\.t$/,
+		add => [ q{$ENV{DBI_SQL_NANO} = 1} ],
 	},
     #   mx => {	name => "DBD::Multiplex",
-    #               add => [ q{local $ENV{DBI_AUTOPROXY} = 'dbi:Multiplex:';} ],
+    #           add => [ q{local $ENV{DBI_AUTOPROXY} = 'dbi:Multiplex:';} ],
     #   }
     #   px => {	name => "DBD::Proxy",
     #		need mechanism for starting/stopping the proxy server
@@ -3348,8 +3344,22 @@
     );
 
     # decide what needs doing
-    $dbd_attr->{create_pp_tests} or delete @test_variants{'p','q','xqp'};
+    $dbd_attr->{create_pp_tests} or delete $test_variants{p};
     $dbd_attr->{create_nano_tests} or delete $test_variants{n};
+    $dbd_attr->{create_gap_tests} or delete $test_variants{g};
+
+    # expand for all combinations
+    my @all_keys = my @tv_keys = sort keys %test_variants;
+    while( @tv_keys ) {
+	my $cur_key = shift @tv_keys;
+	last if( 1 < length $cur_key );
+	my @new_keys;
+	foreach my $remain (@tv_keys) {
+	    push @new_keys, $cur_key . $remain unless $remain =~ /$cur_key/;
+	}
+	push @tv_keys, @new_keys;
+	push @all_keys, @new_keys;
+    }
 
     # do whatever needs doing
     if( keys %test_variants ) {
@@ -3359,11 +3369,23 @@
 	my @tests = grep { /\.t$/ } readdir DIR;
 	closedir DIR;
 
-        while ( my ($v_type, $v_info) = each %test_variants ) {
-            printf "Creating test wrappers for $v_info->{name}:\n";
+        foreach my $test_combo (@all_keys) {
+	    @tv_keys = split //, $test_combo;
+	    my @test_names = map { $test_variants{$_}->{name} } @tv_keys;
+            printf "Creating test wrappers for " . join( " + ", @test_names ) . ":\n";
+	    my @test_matches = map { $test_variants{$_}->{match} } @tv_keys;
+	    my @test_adds;
+	    foreach my $test_add ( map { $test_variants{$_}->{add} } @tv_keys) {
+		push @test_adds, @$test_add;
+	    }
+	    my $v_type = $test_combo;
+	    $v_type = 'x' . $v_type if length( $v_type ) > 1;
 
+	TEST:
             foreach my $test (sort @tests) {
-                next if $test !~ $v_info->{match};
+		foreach my $match (@test_matches) {
+		    next TEST if $test !~ $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";
@@ -3371,7 +3393,7 @@
 		open PPT, ">$v_test" or warn "Can't create $v_test: $!";
 		print PPT "#!$v_perl\n";
 		print PPT "use threads;\n" if $usethr;
-		print PPT "$_;\n" foreach @{$v_info->{add}};
+		print PPT "$_;\n" foreach @test_adds;
 		print PPT "require './t/$test'; # or warn \$!;\n";
 		close PPT or warn "Error writing $v_test: $!";
 	    }