Major overhaul of select/as resolution handling (fixes RT#61235)

[dbsrgits/DBIx-Class.git] / t / 52leaks.t

diff --git a/t/52leaks.t b/t/52leaks.t
index 2f1867d..79f6a1c 100644 (file)
--- a/t/52leaks.t
+++ b/t/52leaks.t
@@ -12,18 +12,18 @@ BEGIN {
 }
 
 use Test::More;
+
+use lib qw(t/lib);
+use DBICTest::RunMode;
 BEGIN {
-  plan skip_all => '5.13.6 leaks like a sieve (fixed in blead/cefd5c7c)'
-    if $] == '5.013006';
+  plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test"
+    if DBICTest::RunMode->peepeeness;
 }
 
 use Scalar::Util qw/refaddr reftype weaken/;
 use Carp qw/longmess/;
 use Try::Tiny;
 
-use lib qw(t/lib);
-use DBICTest::RunMode;
-
 my $have_test_cycle;
 BEGIN {
   require DBIx::Class::Optional::Dependencies;
@@ -128,6 +128,10 @@ unless (DBICTest::RunMode->is_plain) {
 
     resultset => $rs,
 
+    # twice so that we make sure only one H::M object spawned
+    chained_resultset => $rs->search_rs ({}, { '+columns' => [ 'foo' ] } ),
+    chained_resultset2 => $rs->search_rs ({}, { '+columns' => [ 'bar' ] } ),
+
     row_object => $row_obj,
 
     result_source => $rs->result_source,
@@ -156,15 +160,23 @@ memory_cycle_ok($weak_registry, 'No cycles in the weakened object collection')
 # Naturally we have some exceptions
 my $cleared;
 for my $slot (keys %$weak_registry) {
-  if ($slot =~ /^\QSQL::Translator/) {
+  if ($slot =~ /^\QTest::Builder/) {
+    # T::B 2.0 has result objects and other fancyness
+    delete $weak_registry->{$slot};
+  }
+  elsif ($slot =~ /^\QSQL::Translator/) {
     # SQLT is a piece of shit, leaks all over
     delete $weak_registry->{$slot};
   }
   elsif ($slot =~ /^\QHash::Merge/) {
-    # only clear one object - more would indicate trouble
+    # only clear one object of a specific behavior - more would indicate trouble
     delete $weak_registry->{$slot}
       unless $cleared->{hash_merge_singleton}{$weak_registry->{$slot}{weakref}{behavior}}++;
   }
+  elsif ($slot =~ /^__TxnScopeGuard__FIXUP__/) {
+    die 'The $@ debacle should have been fixed by now!!!' if $] >= 5.013008;
+    delete $weak_registry->{$slot};
+  }
 }