From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 16 Jun 2016 15:40:44 +0000 (+0200)
Subject: Change the leaktracer to no longer rely on %Sub::Quote::QUOTED
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dc715747;p=dbsrgits%2FDBIx-Class.git

Change the leaktracer to no longer rely on %Sub::Quote::QUOTED

Frees up @haarg to do as he sees fit in the future
---

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index d077124..d7b1ce2 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -185,6 +185,7 @@ BEGIN {
   Sub::Quote->VERSION(2.002);
 }
 # Override forcing no_defer, and adding naming consistency checks
+our %refs_closed_over_by_quote_sub_installed_crefs;
 sub quote_sub {
   Carp::confess( "Anonymous quoting not supported by the DBIC sub_quote override - supply a sub name" ) if
     @_ < 2
@@ -217,6 +218,22 @@ sub quote_sub {
     no_defer => 1,
   };
 
+  weaken (
+    # just use a growing counter, no need to perform neither compaction
+    # nor any special ithread-level handling
+    $refs_closed_over_by_quote_sub_installed_crefs
+     { scalar keys %refs_closed_over_by_quote_sub_installed_crefs }
+      = $_
+  ) for grep {
+    length ref $_
+      and
+    (
+      ! DBIx::Class::_ENV_::BROKEN_WEAK_SCALARREF_VALUES
+        or
+      ref $_ ne 'SCALAR'
+    )
+  } values %{ $_[2] || {} };
+
   my $cref = Sub::Quote::quote_sub( $_[0], $_[1], $_[2]||{}, $sq_opts );
 
   # FIXME FIXME FIXME
diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm
index 8002e69..b36843e 100644
--- a/t/lib/DBICTest/Util/LeakTracer.pm
+++ b/t/lib/DBICTest/Util/LeakTracer.pm
@@ -250,13 +250,13 @@ sub assert_empty_weakregistry {
 
   # the symtable walk is very expensive
   # if we are $quiet (running in an END block) we do not really need to be
-  # that thorough - can get by with only %Sub::Quote::QUOTED
+  # that thorough - can get by with our own registry
   delete $weak_registry->{$_} for $quiet
     ? do {
       my $refs = {};
       visit_refs (
         # only look at the closed over stuffs
-        refs => [ grep { length ref $_ } map { values %{$_->[2]} } grep { ref $_ eq 'ARRAY' } values %Sub::Quote::QUOTED ],
+        refs => [ values %DBIx::Class::_Util::refs_closed_over_by_quote_sub_installed_crefs ],
         seen_refs => $refs,
         action => sub { 1 },
       );