Remove erroneous undefer introduced in 8d73fcd4 (confuses old perls in END)

[dbsrgits/DBIx-Class.git] / t / lib / DBICTest / Util / LeakTracer.pm

diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm
index 1f2caf5..3da3b86 100644 (file)
--- a/t/lib/DBICTest/Util/LeakTracer.pm
+++ b/t/lib/DBICTest/Util/LeakTracer.pm
@@ -8,7 +8,7 @@ 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 DBICTest::Util 'stacktrace';
+use DBICTest::Util qw( stacktrace visit_namespaces );
 use constant {
   CV_TRACING => DBIx::Class::Optional::Dependencies->req_ok_for ('test_leaks_heavy'),
 };
@@ -148,30 +148,6 @@ sub visit_refs {
   $visited_cnt;
 }
 
-sub visit_namespaces {
-  my $args = { (ref $_[0]) ? %{$_[0]} : @_ };
-
-  my $visited = 1;
-
-  $args->{package} ||= '::';
-  $args->{package} = '::' if $args->{package} eq 'main';
-
-  if ( $args->{action}->($args->{package}) ) {
-
-    my $base = $args->{package};
-    $base = '' if $base eq '::';
-
-
-    $visited += visit_namespaces({ %$args, package => $_ }) for map
-      { $_ =~ /(.+?)::$/ ? "${base}::$1" : () }
-      grep
-        { $_ =~ /(?<!^main)::$/ }
-        do {  no strict 'refs'; keys %{ $base . '::'} }
-  }
-
-  return $visited;
-}
-
 # compiles a list of addresses stored as globals (possibly even catching
 # class data in the form of method closures), so we can skip them further on
 sub symtable_referenced_addresses {
@@ -185,8 +161,6 @@ sub symtable_referenced_addresses {
       no strict 'refs';
 
       my $pkg = shift;
-      $pkg = '' if $pkg eq '::';
-      $pkg .= '::';
 
       # the unless regex at the end skips some dangerous namespaces outright
       # (but does not prevent descent)
@@ -196,23 +170,23 @@ sub symtable_referenced_addresses {
         action => sub { 1 },
 
         refs => [ map { my $sym = $_;
-          # *{"$pkg$sym"}{CODE} won't simply work - MRO-cached CVs are invisible there
-          ( CV_TRACING ? Class::MethodCache::get_cv("${pkg}$sym") : () ),
+          # *{"${pkg}::$sym"}{CODE} won't simply work - MRO-cached CVs are invisible there
+          ( CV_TRACING ? Class::MethodCache::get_cv("${pkg}::$sym") : () ),
 
-          ( defined *{"$pkg$sym"}{SCALAR} and length ref ${"$pkg$sym"} and ! isweak( ${"$pkg$sym"} ) )
-            ? ${"$pkg$sym"} : ()
+          ( defined *{"${pkg}::$sym"}{SCALAR} and length ref ${"${pkg}::$sym"} and ! isweak( ${"${pkg}::$sym"} ) )
+            ? ${"${pkg}::$sym"} : ()
           ,
 
           ( map {
-            ( defined *{"$pkg$sym"}{$_} and ! isweak(defined *{"$pkg$sym"}{$_}) )
-              ? *{"$pkg$sym"}{$_}
+            ( defined *{"${pkg}::$sym"}{$_} and ! isweak(defined *{"${pkg}::$sym"}{$_}) )
+              ? *{"${pkg}::$sym"}{$_}
               : ()
           } qw(HASH ARRAY IO GLOB) ),
 
-        } keys %$pkg ],
-      ) unless $pkg =~ /^ :: (?:
+        } keys %{"${pkg}::"} ],
+      ) unless $pkg =~ /^ (?:
         DB | next | B | .+? ::::ISA (?: ::CACHE ) | Class::C3
-      ) :: $/x;
+      ) $/x;
     }
   );
 
@@ -230,8 +204,6 @@ sub symtable_referenced_addresses {
 sub assert_empty_weakregistry {
   my ($weak_registry, $quiet) = @_;
 
-  Sub::Defer::undefer_all();
-
   # in case we hooked bless any extra object creation will wreak
   # havoc during the assert phase
   local *CORE::GLOBAL::bless;
@@ -356,20 +328,23 @@ END {
       $tb->note("Auto checked $refs_traced references for leaks - none detected");
     }
 
-# Disable this until better times - SQLT and probably other things
-# still load strictures. Let's just wait until Moo2.0 and go from there
-=begin for tears
     # also while we are here and not in plain runmode: make sure we never
     # loaded any of the strictures XS bullshit (it's a leak in a sense)
-    unless (DBICTest::RunMode->is_plain) {
+    unless (
+      $ENV{MOO_FATAL_WARNINGS}
+        or
+      # FIXME - SQLT loads strictures explicitly, /facedesk
+      # remove this INC check when 0fb58589 and 45287c815 are rectified
+      $INC{'SQL/Translator.pm'}
+        or
+      DBICTest::RunMode->is_plain
+    ) {
       for (qw(indirect multidimensional bareword::filehandles)) {
         exists $INC{ Module::Runtime::module_notional_filename($_) }
           and
         $tb->ok(0, "$_ load should not have been attempted!!!" )
       }
     }
-=cut
-
   }
 }