Even better localization of $@, and don't use Test::Warn for the time being, as somet...

diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
index a798791..122e016 100644 (file)
--- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm
+++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
@@ -25,30 +25,32 @@ sub DESTROY {
 
   my $exception = $@;
 
-  carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
-    unless $exception;
-
-  my $rollback_exception;
   {
     local $@;
+
+    carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
+      unless $exception;
+
     eval { $storage->txn_rollback };
-    $rollback_exception = $@;
-  }
+    my $rollback_exception = $@;
 
-  if ($rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
-    if ($exception) {
-      $@ = "Transaction aborted: ${exception} "
+    if ($rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
+      if ($exception) {
+        $exception = "Transaction aborted: ${exception} "
           ."Rollback failed: ${rollback_exception}";
-    }
-    else {
-      carp (join ' ',
-        "********************* ROLLBACK FAILED!!! ********************",
-        "\nA rollback operation failed after the guard went out of scope.",
-        'This is potentially a disastrous situation, check your data for',
-        "consistency: $rollback_exception"
-      );
+      }
+      else {
+        carp (join ' ',
+          "********************* ROLLBACK FAILED!!! ********************",
+          "\nA rollback operation failed after the guard went out of scope.",
+          'This is potentially a disastrous situation, check your data for',
+          "consistency: $rollback_exception"
+        );
+      }
     }
   }
+
+  $@ = $exception;
 }
 
 1;

diff --git a/t/81transactions.t b/t/81transactions.t
index 00c9418..c1300de 100644 (file)
--- a/t/81transactions.t
+++ b/t/81transactions.t
@@ -333,7 +333,10 @@ $schema->storage->disconnect;
 {
   my $schema = DBICTest->init_schema();
 
-  warnings_exist (sub {
+  # something is really confusing Test::Warn here, no time to debug
+=begin
+  warnings_exist (
+    sub {
       my $guard = $schema->txn_scope_guard;
       $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
 
@@ -345,6 +348,30 @@ $schema->storage->disconnect;
     ],
     'proper warnings generated on out-of-scope+rollback failure'
   );
+=cut
+
+  my @want = (
+    qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./,
+    qr/\*+ ROLLBACK FAILED\!\!\! \*+/,
+  );
+
+  my @w;
+  local $SIG{__WARN__} = sub {
+    if (grep {$_[0] =~ $_} (@want)) {
+      push @w, $_[0];
+    }
+    else {
+      warn $_[0];
+    }
+  };
+  {
+      my $guard = $schema->txn_scope_guard;
+      $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
+
+      $schema->storage->disconnect;  # this should freak out the guard rollback
+  }
+
+  is (@w, 2, 'Both expected warnings found');
 }
 
 done_testing;