Author: REHSACK
Date: Mon May 24 05:08:04 2010
New Revision: 14024
Modified:
dbi/trunk/t/50dbm_simple.t
Log:
prove $sth->rows after DELETE and UPDATE statements
Modified: dbi/trunk/t/50dbm_simple.t
==============================================================================
--- dbi/trunk/t/50dbm_simple.t (original)
+++ dbi/trunk/t/50dbm_simple.t Mon May 24 05:08:04 2010
@@ -54,6 +54,23 @@
}
}
}
+
+ if( eval { require List::MoreUtils; } )
+ {
+ List::MoreUtils->import("part");
+ }
+ else
+ {
+ # XXX from PP part of List::MoreUtils
+ eval <<'EOP';
+sub part(&@) {
+ my ($code, @list) = @_;
+ my @parts;
+ push @{ $parts[$code->($_)] }, $_ for @list;
+ return @parts;
+}
+EOP
+ }
}
my $dir = File::Spec->catdir(getcwd(),'test_output');
@@ -61,7 +78,7 @@
rmtree $dir;
mkpath $dir;
-my %expected_results = (
+my %tests_statement_results = (
2 => [
"DROP TABLE IF EXISTS fruit", -1,
"CREATE TABLE fruit (dKey INT, dVal VARCHAR(10))", '0E0',
@@ -111,15 +128,29 @@
print "Using DBM modules: @dbm_types\n";
print "Using MLDBM serializers: @mldbm_types\n" if @mldbm_types;
+my %test_statements;
+my %expected_results;
+
+for my $columns ( 2 .. 3 )
+{
+ my $i = 0;
+ my @tests = part { $i++ % 2 } @{ $tests_statement_results{$columns} };
+ @{ $test_statements{$columns} } = @{$tests[0]};
+ @{ $expected_results{$columns} } = @{$tests[1]};
+}
+
my $tests_offsets_group = 5;
my $ndbm_types = scalar @dbm_types;
my $nmldbm_types = scalar @mldbm_types;
-my $tests_without_mldbm = $tests_offsets_group +
scalar(@{$expected_results{2}}) / 2 + 1;
-my $tests_with_mldbm = ( $nmldbm_types - 1 ) * ($tests_offsets_group +
scalar(@{$expected_results{3}})/2 + 1);
+my $tests_without_mldbm = $tests_offsets_group +
scalar(@{$test_statements{2}});
+ $tests_without_mldbm += grep { m/^(?:SELECT|UPDATE|DELETE)/ } @{
$test_statements{2} };
+my $tests_with_mldbm = $tests_offsets_group + scalar(@{$test_statements{3}});
+ $tests_with_mldbm += grep { m/^(?:SELECT|UPDATE|DELETE)/ } @{
$test_statements{3} };
+ $tests_with_mldbm *= $nmldbm_types - 1;
my $num_tests = $ndbm_types * ( $tests_without_mldbm + $tests_with_mldbm );
printf "Test count: %d x ( ( %d + %d ) + %d x ( %d + %d ) ) = %d\n",
- scalar $ndbm_types, $tests_offsets_group, scalar(@{$expected_results{2}})
/ 2 + 1,
- $nmldbm_types - 1, $tests_offsets_group,
scalar(@{$expected_results{3}})/2 + 1,
+ $ndbm_types, $tests_offsets_group, $tests_without_mldbm -
$tests_offsets_group,
+ $nmldbm_types - 1, $tests_offsets_group, $tests_with_mldbm /
($nmldbm_types - 1) - $tests_offsets_group,
$num_tests;
if (!$num_tests) {
@@ -130,25 +161,17 @@
}
for my $mldbm ( @mldbm_types ) {
- my @sql = ($mldbm) ? @{$expected_results{3}} : @{$expected_results{2}};
+ my $columns = ($mldbm) ? 3 : 2;
for my $dbm_type ( @dbm_types ) {
print "\n--- Using $dbm_type ($mldbm) ---\n";
- eval { do_test( $dbm_type, $mldbm, @sql) }
+ eval { do_test( $dbm_type, $mldbm, $columns) }
or warn $@;
}
}
rmtree $dir;
-# XXX from PP part of List::MoreUtils
-sub part(&@) {
- my ($code, @list) = @_;
- my @parts;
- push @{ $parts[$code->($_)] }, $_ for @list;
- return @parts;
-}
-
sub do_test {
- my ($dtype, $mldbm, @sqltests) = @_;
+ my ($dtype, $mldbm, $columns) = @_;
my $test_builder = Test::More->builder;
my $starting_test_no = $test_builder->current_test;
@@ -200,11 +223,8 @@
};
ok($@);
- # XXX I would prefer use List::Moreutils::part ...
- my $i = 0;
- my @tests = part { $i++ % 2 } @sqltests;
- my @queries = @{$tests[0]};
- my @results = @{dclone $tests[1]};
+ my @queries = @{$test_statements{$columns}};
+ my @results = @{$expected_results{$columns}};
SKIP:
for my $idx ( 0 .. $#queries ) {
@@ -230,19 +250,20 @@
my $n = $sth->execute(@bind);
if ($sth->err and $sql !~ /^DROP/ ) {
skip "execute failed: " . $sth->errstr || 'unknown error',
- ($sql =~ /SELECT/) ? 2 : 1;
+ ($sql =~ /^(?:SELECT|UPDATE|DELETE)/) ? 2 : 1;
}
is( $n, $results[$idx], $sql ) unless( 'ARRAY' eq ref $results[$idx] );
+ TODO: {
+ local $TODO = "AUTOPROXY drivers might throw away sth->rows()";
+ is( $n, $sth->rows, '$sth->execute(' . $sql . ') == $sth->rows' )
if( $sql =~ m/^(?:UPDATE|DELETE)/ );
+ }
next unless $sql =~ /SELECT/;
my $results='';
# Note that we can't rely on the order here, it's not portable,
# different DBMs (or versions) will return different orders.
my $allrows = $sth->fetchall_arrayref();
my $expected_rows = $results[$idx];
- TODO: {
- local $TODO = "Proxying DBD's might not return amount of fetched
rows";
- is( $sth->rows, scalar( @{$expected_rows} ), $sql );
- }
+ is( $sth->rows, scalar( @{$expected_rows} ), $sql );
is_deeply( $allrows, $expected_rows, 'SELECT results' );
}
$dbh->disconnect;
