X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest%2FUtil%2FLeakTracer.pm;h=8e2e6e8962a59ac48febbf6cee374d1ae82b449e;hb=8fc4291ef4f19b6f4c4f25cd695cb613da613fe1;hp=447d0ec10767692cfbce8acea59617d58ea0fbcb;hpb=5e5823f108f61bd7afa01c180102bc42bad3834b;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm
index 447d0ec..8e2e6e8 100644
--- a/t/lib/DBICTest/Util/LeakTracer.pm
+++ b/t/lib/DBICTest/Util/LeakTracer.pm
@@ -3,14 +3,20 @@ package DBICTest::Util::LeakTracer;
 use warnings;
 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::Optional::Dependencies;
-use Data::Dumper::Concise;
+use DBIx::Class::_Util qw(refcount hrefaddr refdesc dump_value);
+use DBICTest::RunMode;
 use DBICTest::Util qw( stacktrace visit_namespaces );
 use constant {
-  CV_TRACING => !DBICTest::RunMode->is_plain && DBIx::Class::Optional::Dependencies->req_ok_for ('test_leaks_heavy'),
+  CV_TRACING => !!(
+    !DBICTest::RunMode->is_plain
+      &&
+    require DBIx::Class::Optional::Dependencies
+      &&
+    DBIx::Class::Optional::Dependencies->req_ok_for ('test_leaks_heavy')
+  ),
 };
 
 use base 'Exporter';
@@ -50,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};
@@ -90,6 +97,11 @@ sub CLONE {
       $reg->{$new_addr} = $slot_info;
     }
   }
+
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 sub visit_refs {
@@ -122,6 +134,7 @@ sub visit_refs {
 
     my $type = reftype $r;
 
+    local $SIG{__DIE__} if $SIG{__DIE__};
     local $@;
     eval {
       if ($type eq 'HASH') {
@@ -207,7 +220,7 @@ sub assert_empty_weakregistry {
   # in case we hooked bless any extra object creation will wreak
   # havoc during the assert phase
   local *CORE::GLOBAL::bless;
-  *CORE::GLOBAL::bless = sub { CORE::bless( $_[0], (@_ > 1) ? $_[1] : caller() ) };
+  *CORE::GLOBAL::bless = sub { CORE::bless( $_[0], (@_ > 1) ? $_[1] : CORE::caller() ) };
 
   croak 'Expecting a registry hashref' unless ref $weak_registry eq 'HASH';
 
@@ -266,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}
       ;
     };
 
@@ -299,7 +312,7 @@ sub assert_empty_weakregistry {
   }
 
   if (! $quiet and !$leaks_found and ! $tb->in_todo) {
-    $tb->ok(1, sprintf "No leaks found at %s line %d", (caller())[1,2] );
+    $tb->ok(1, sprintf "No leaks found at %s line %d", (CORE::caller())[1,2] );
   }
 }