Prevent CLONE from potentially running more than once
[dbsrgits/DBIx-Class.git] / t / lib / DBICTest / Util / LeakTracer.pm
index 82ff010..4873d77 100644 (file)
@@ -6,9 +6,8 @@ use strict;
 use ANFANG;
 use Carp;
 use Scalar::Util qw(isweak weaken blessed reftype);
-use DBIx::Class::_Util qw(refcount hrefaddr refdesc);
+use DBIx::Class::_Util qw(refcount hrefaddr refdesc dump_value);
 use DBICTest::RunMode;
-use Data::Dumper::Concise;
 use DBICTest::Util qw( stacktrace visit_namespaces );
 use constant {
   CV_TRACING => !!(
@@ -57,6 +56,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};
@@ -73,7 +73,7 @@ sub populate_weakregistry {
 }
 
 # Regenerate the slots names on a thread spawn
-sub CLONE {
+sub DBICTest::__LeakTracer_iThreads_handler__::CLONE {
   my @individual_regs = grep { scalar keys %{$_||{}} } values %reg_of_regs;
   %reg_of_regs = ();
 
@@ -134,6 +134,7 @@ sub visit_refs {
 
     my $type = reftype $r;
 
+    local $SIG{__DIE__} if $SIG{__DIE__};
     local $@;
     eval {
       if ($type eq 'HASH') {
@@ -278,7 +279,7 @@ sub assert_empty_weakregistry {
           ref($weak_registry->{$addr}{weakref}) eq 'CODE'
             and
           B::svref_2object($weak_registry->{$addr}{weakref})->XSUB
-        ) ? '__XSUB__' : Dumper( $weak_registry->{$addr}{weakref} )
+        ) ? '__XSUB__' : dump_value $weak_registry->{$addr}{weakref}
       ;
     };