The complete fix for intermittent t/750firebird.t failures (RT#110979)

It makes no sense to throw values away in case the finish() failed - they are
good regardless. Not sure what I was thinking at the time :(

See also next commit

diff --git a/Changes b/Changes
index 8f02e8d..64f5325 100644 (file)
--- a/Changes
+++ b/Changes
@@ -29,6 +29,8 @@ Revision history for DBIx::Class
         - Fix spurious ROLLBACK statements when a TxnScopeGuard fails a commit
           of a transaction with deferred FK checks: a guard is now inactivated
           immediately before the commit is attempted (RT#107159)
+        - Work around unreliable $sth->finish() on INSERT ... RETURNING within
+          DBD::Firebird on some compiler/driver combinations (RT#110979)
         - Fix several corner cases with Many2Many over custom relationships
         - Fix t/52leaks.t failures on compilerless systems (RT#104429)
         - Fix t/105view_deps.t failing with libsqlite >= 3.009, where view

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 65293c3..af27c55 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1968,12 +1968,30 @@ sub insert {
 
   my %returned_cols = %$to_insert;
   if (my $retlist = $sqla_opts->{returning}) {  # if IR is supported - we will get everything in one set
-    @ir_container = try {
-      local $SIG{__WARN__} = sub {};
-      my @r = $sth->fetchrow_array;
-      $sth->finish;
-      @r;
-    } unless @ir_container;
+
+    unless( @ir_container ) {
+      try {
+
+        # FIXME - need to investigate why Caelum silenced this in 4d4dc518
+        local $SIG{__WARN__} = sub {};
+
+        @ir_container = $sth->fetchrow_array;
+        $sth->finish;
+
+      } catch {
+        # Evict the $sth from the cache in case we got here, since the finish()
+        # is crucial, at least on older Firebirds, possibly on other engines too
+        #
+        # It would be too complex to make this a proper subclass override,
+        # and besides we already take the try{} penalty, adding a catch that
+        # triggers infrequently is a no-brainer
+        #
+        if( my $kids = $self->_dbh->{CachedKids} ) {
+          $kids->{$_} == $sth and delete $kids->{$_}
+            for keys %$kids
+        }
+      };
+    }
 
     @returned_cols{@$retlist} = @ir_container if @ir_container;
   }

diff --git a/t/750firebird.t b/t/750firebird.t
index 1d06387..f5bd6e6 100644 (file)
--- a/t/750firebird.t
+++ b/t/750firebird.t
@@ -43,12 +43,6 @@ my @test_order = map { "DBICTEST_FIREBIRD$_" }
 
 for my $prefix (@test_order) { SKIP: {
 
-  my ($dsn, $user, $pass) = map { $ENV{"${prefix}_$_"} } qw/DSN USER PASS/;
-
-  next unless $dsn;
-
-  note "Testing with ${prefix}_DSN";
-
   skip ("Testing with ${prefix}_DSN needs " . DBIx::Class::Optional::Dependencies->req_missing_for( $env2optdep->{$prefix} ), 1)
     unless  DBIx::Class::Optional::Dependencies->req_ok_for($env2optdep->{$prefix});
 
@@ -56,6 +50,10 @@ for my $prefix (@test_order) { SKIP: {
     if $prefix eq 'DBICTEST_FIREBIRD_INTERBASE' and
       ($ENV{DBICTEST_FIREBIRD_DSN} or $ENV{DBICTEST_FIREBIRD_ODBC_DSN});
 
+  my ($dsn, $user, $pass) = map { $ENV{"${prefix}_$_"} } qw/DSN USER PASS/;
+
+  note "Testing with ${prefix}_DSN";
+
   $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
     auto_savepoint  => 1,
     quote_names     => 1,