Expand ASSERT_NO_SPURIOUS_EXCEPTION_ACTION to set a rogue $SIG{__DIE__}
Peter Rabbitson [Tue, 22 Mar 2016 22:43:19 +0000 (23:43 +0100)]
This simple augmentation of ddcc02d1 caught a couple extra spots where a
__DIE__ handler could be incorrectly triggered (one of them ironically
introduced by 86cdddbe which happened *after* the work in ddcc02d1)

See next commit for *YET MORE* of the same...

lib/DBIx/Class/Optional/Dependencies.pm
lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/Schema.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/_Util.pm
t/lib/DBICTest/BaseSchema.pm
t/lib/DBICTest/Util/LeakTracer.pm
t/storage/txn_scope_guard.t

index 7b447ef..43790b2 100644 (file)
@@ -1156,6 +1156,9 @@ sub _errorlist_for_modreqs {
     my $v = $reqs->{$m};
 
     if (! exists $req_unavailability_cache{$m}{$v} ) {
+      # masking this off is important, as it may very well be
+      # a transient error
+      local $SIG{__DIE__} if $SIG{__DIE__};
       local $@;
       eval( "require $m;" . ( $v ? "$m->VERSION(q($v))" : '' ) );
       $req_unavailability_cache{$m}{$v} = $@;
index 0940e0d..847cecb 100644 (file)
@@ -2358,6 +2358,7 @@ sub DESTROY {
   # which will serve as a signal to not try doing anything else
   # however beware - on older perls the exception seems randomly untrappable
   # due to some weird race condition during thread joining :(((
+  local $SIG{__DIE__} if $SIG{__DIE__};
   local $@;
   eval {
     weaken $_[0]->{schema};
index 1742705..7527ddf 100644 (file)
@@ -1448,6 +1448,7 @@ sub DESTROY {
     # however beware - on older perls the exception seems randomly untrappable
     # due to some weird race condition during thread joining :(((
     if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
+      local $SIG{__DIE__} if $SIG{__DIE__};
       local $@;
       eval {
         $srcs->{$source_name}->schema($self);
index cafdf19..1f66d71 100644 (file)
@@ -904,10 +904,8 @@ sub disconnect {
 
   my $g = scope_guard {
 
-    {
-      local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
-      eval { $self->_dbh->disconnect };
-    }
+    defined( $self->_dbh )
+      and dbic_internal_try { $self->_dbh->disconnect };
 
     $self->_dbh(undef);
     $self->_dbh_details({});
index 358a3aa..8c62054 100644 (file)
@@ -161,6 +161,7 @@ sub is_exception ($) {
 
   my ($not_blank, $suberror);
   {
+    local $SIG{__DIE__} if $SIG{__DIE__};
     local $@;
     eval {
       # The ne() here is deliberate - a plain length($e), or worse "$e" ne
@@ -270,9 +271,7 @@ sub is_exception ($) {
         unless $callstack_state->{in_internal_try};
 
       # always unset - someone may have snuck it in
-      local $SIG{__DIE__}
-        if $SIG{__DIE__};
-
+      local $SIG{__DIE__} if $SIG{__DIE__};
 
       if( $wantarray ) {
         @ret = $try_cref->();
@@ -383,8 +382,8 @@ sub modver_gt_or_eq ($$) {
     local $SIG{__WARN__} = sigwarn_silencer( qr/\Qisn't numeric in subroutine entry/ )
       if SPURIOUS_VERSION_CHECK_WARNINGS;
 
+    local $SIG{__DIE__} if $SIG{__DIE__};
     local $@;
-    local $SIG{__DIE__};
     eval { $mod->VERSION($ver) } ? 1 : 0;
   };
 
index 0214933..111b84b 100644 (file)
@@ -13,7 +13,7 @@ use DBICTest::Util qw( local_umask tmpdir await_flock dbg DEBUG_TEST_CONCURRENCY
 use namespace::clean;
 
 if( $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION} ) {
-  __PACKAGE__->exception_action( sub {
+  my $ea = __PACKAGE__->exception_action( sub {
 
     my ( $fr_num, $disarmed, $throw_exception_fr_num );
     while( ! $disarmed and my @fr = caller(++$fr_num) ) {
@@ -55,7 +55,27 @@ if( $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION} ) {
     ) unless $disarmed;
 
     DBIx::Class::Exception->throw( $_[0] );
-  })
+  });
+
+  my $interesting_ns_rx = qr/^ (?: main$ | DBIx::Class:: | DBICTest:: ) /x;
+
+  # hard-set $SIG{__DIE__} to the class-wide exception_action
+  # with a little escape preceeding it
+  $SIG{__DIE__} = sub {
+
+    # without this there would be false positives everywhere :(
+    die @_ if (
+      (caller(0))[0] !~ $interesting_ns_rx
+        or
+      (
+        caller(0) eq 'main'
+          and
+        (caller(1))[0] !~ $interesting_ns_rx
+      )
+    );
+
+    &$ea;
+  };
 }
 
 sub capture_executed_sql_bind {
@@ -216,6 +236,7 @@ sub connection {
       # we need to work with a forced fresh clone so that we do not upset any state
       # of the main $schema (some tests examine it quite closely)
       local $SIG{__WARN__} = sub {};
+      local $SIG{__DIE__};
       local $@;
 
       # this will either give us an undef $locktype or will determine things
index 82ff010..03a8a13 100644 (file)
@@ -57,6 +57,7 @@ sub populate_weakregistry {
 
     # on perl < 5.8.3 sometimes a weaken can throw (can't find RT)
     # so guard against that unlikely event
+    local $SIG{__DIE__} if $SIG{__DIE__};
     local $@;
     eval { weaken( $weak_registry->{$refaddr}{weakref} ); $refs_traced++ }
       or delete $weak_registry->{$refaddr};
@@ -134,6 +135,7 @@ sub visit_refs {
 
     my $type = reftype $r;
 
+    local $SIG{__DIE__} if $SIG{__DIE__};
     local $@;
     eval {
       if ($type eq 'HASH') {
index 56d602d..e9e69a3 100644 (file)
@@ -139,6 +139,11 @@ require DBICTest::AntiPattern::NullObject;
     }
   };
 
+
+  # we are driving manually here, do not allow interference
+  local $SIG{__DIE__} if $SIG{__DIE__};
+
+
   no warnings 'redefine';
   local *DBIx::Class::Storage::DBI::txn_rollback = sub { die 'die die my darling' };
   Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;