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

[REHSACK]

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: $!";
            }