Relax overly aggressive exception-well-formedness checks from 84e4e006

Given that the actual exception codepaths within DBIC are not affected by
a leftover non-cooperative exception object present in $@, it is rather
counterproductive to warn out the PSA in these cases

diff --git a/AUTHORS b/AUTHORS
index 02bf6a0..64007a9 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -25,6 +25,7 @@ amiri: Amiri Barksdale <amiribarksdale@gmail.com>
 amoore: Andrew Moore <amoore@cpan.org>
 Andrew Mehta <Andrew@unitedgames.co.uk>
 andrewalker: Andre Walker <andre@andrewalker.net>
+andybev: Andrew Beverley <a.beverley@ctrlo.com>
 andyg: Andy Grundman <andy@hybridized.org>
 ank: Andres Kievsky <ank@ank.com.ar>
 arc: Aaron Crane <arc@cpan.org>

diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
index 841337f..353e5c5 100644 (file)
--- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm
+++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
@@ -24,7 +24,10 @@ sub new {
   # FIXME FRAGILE - any eval that fails but *does not* rethrow between here
   # and the unwind will trample over $@ and invalidate the entire mechanism
   # There got to be a saner way of doing this...
-  if (is_exception $@) {
+  #
+  # Deliberately *NOT* using is_exception - if someone left a misbehaving
+  # antipattern value in $@, it's not our business to whine about it
+  if( defined $@ and length $@ ) {
     weaken(
       $guard->{existing_exception_ref} = (length ref $@) ? $@ : \$@
     );

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 362bb35..32fdf0c 100644 (file)
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -148,6 +148,7 @@ sub scope_guard (&) {
 sub is_exception ($) {
   my $e = $_[0];
 
+  # FIXME
   # this is not strictly correct - an eval setting $@ to undef
   # is *not* the same as an eval setting $@ to ''
   # but for the sake of simplicity assume the following for
@@ -210,7 +211,7 @@ sub is_exception ($) {
     . 'does) result in silent discarding of errors. DBIx::Class tries to '
     . 'work around this as much as possible, but other parts of your '
     . 'software stack may not be even aware of the problem. Please submit '
-    . 'a bugreport against the distribution containing %s.',
+    . 'a bugreport against the distribution containing %s',
 
       ($class) x 2,
     ));

diff --git a/t/33exception_wrap.t b/t/33exception_wrap.t
index 40a7ea0..3b351ab 100644 (file)
--- a/t/33exception_wrap.t
+++ b/t/33exception_wrap.t
@@ -38,6 +38,15 @@ for my $ap (qw(
     isa_ok $@, $ap;
   } qr/\QObjects of external exception class '$ap' stringify to '' (the empty string)/,
     'Proper warning on encountered antipattern';
+
+  warnings_are {
+    $@ = $ap->new;
+    $schema->txn_do (sub { 1 });
+
+    $@ = $ap->new;
+    $schema->txn_scope_guard->commit;
+  } [], 'No spurious PSA warnings on pre-existing antipatterns in $@';
+
 }
 
 done_testing;

diff --git a/t/storage/txn_scope_guard.t b/t/storage/txn_scope_guard.t
index 1b405bd..2df2ab6 100644 (file)
--- a/t/storage/txn_scope_guard.t
+++ b/t/storage/txn_scope_guard.t
@@ -207,6 +207,7 @@ for my $post_poison (0,1) {
   lives_ok {
     # this is what poisons $@
     Text::Balanced::extract_bracketed( '(foo', '()' );
+    DBIx::Class::_Util::is_exception($@);
 
     my $s = DBICTest::Schema->connect('dbi:SQLite::memory:');
     my $g = $s->txn_scope_guard;