From: Peter Rabbitson Date: Sun, 19 Jan 2014 17:08:09 +0000 (+0100) Subject: Stop circref TODO based on RT#82942 from failing after changes in 96577657 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5dc4301c1efffd93c4fc69804dfeae875f8ed0e6;p=dbsrgits%2FDBIx-Class-Historic.git Stop circref TODO based on RT#82942 from failing after changes in 96577657 --- diff --git a/t/52leaks.t b/t/52leaks.t index 4d029f0..5bdede2 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -47,7 +47,8 @@ if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) { use lib qw(t/lib); use DBICTest::RunMode; -use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs); +use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs hrefaddr); +use Scalar::Util qw(weaken); use DBIx::Class; BEGIN { plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test" @@ -87,7 +88,7 @@ unless (DBICTest::RunMode->is_plain) { # re-populate the registry while checking it, ewwww!) return $obj if (ref $obj) =~ /^TB2::/; - # weaken immediately to avoid weird side effects + # populate immediately to avoid weird side effects return populate_weakregistry ($weak_registry, $obj ); }; @@ -257,9 +258,7 @@ unless (DBICTest::RunMode->is_plain) { # this needs to fire, even if it can't find anything # see FIXME below - # we run this only on smokers - trying to establish a pattern - $rs_bind_circref->next - if ( ($ENV{TRAVIS}||'') ne 'true' and DBICTest::RunMode->is_smoker); + $rs_bind_circref->next; require Storable; %$base_collection = ( @@ -371,18 +370,42 @@ for my $addr (keys %$weak_registry) { # FIXME !!! # There is an actual strong circular reference taking place here, but because -# half of it is in XS no leaktracer sees it, and Devel::FindRef is equally -# stumped when trying to trace the origin. The problem is: +# half of it is in XS, so it is a bit harder to track down (it stumps D::FR) +# (our tracker does not yet do it, but it'd be nice) +# The problem is: # # $cond_object --> result_source --> schema --> storage --> $dbh --> {CachedKids} # ^ / # \-------- bound value on prepared/cached STH <-----------/ # { - local $TODO = 'This fails intermittently - see RT#82942'; - if ( my $r = ($weak_registry->{'basic leaky_resultset_cond'}||{})->{weakref} ) { + my @circreffed; + + for my $r (map + { $_->{weakref} } + grep + { $_->{slot_names}{'basic leaky_resultset_cond'} } + values %$weak_registry + ) { + local $TODO = 'Needs Data::Entangled or somesuch - see RT#82942'; ok(! defined $r, 'Self-referential RS conditions no longer leak!') - or $r->result_source(undef); + or push @circreffed, $r; + } + + if (@circreffed) { + is (scalar @circreffed, 1, 'One resultset expected to leak'); + + # this is useless on its own, it is to showcase the circref-diag + # and eventually test it when it is operational + local $TODO = 'Needs Data::Entangled or somesuch - see RT#82942'; + while (@circreffed) { + weaken (my $r = shift @circreffed); + + populate_weakregistry( (my $mini_registry = {}), $r ); + assert_empty_weakregistry( $mini_registry ); + + $r->result_source(undef); + } } } diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm index 600a667..bb1b73e 100644 --- a/t/lib/DBICTest/Util/LeakTracer.pm +++ b/t/lib/DBICTest/Util/LeakTracer.pm @@ -223,7 +223,7 @@ sub assert_empty_weakregistry { next if ! defined $weak_registry->{$addr}{weakref}; - $leaks_found++; + $leaks_found++ unless $tb->in_todo; $tb->ok (0, "Leaked $weak_registry->{$addr}{display_name}"); my $diag = do { @@ -239,6 +239,9 @@ sub assert_empty_weakregistry { ; }; + # FIXME - need to add a circular reference seeker based on the visitor + # (will need a bunch of modifications, punting with just a stub for now) + $diag .= Devel::FindRef::track ($weak_registry->{$addr}{weakref}, 50) . "\n" if ( $ENV{TEST_VERBOSE} && eval { require Devel::FindRef }); @@ -251,7 +254,7 @@ sub assert_empty_weakregistry { $tb->diag($diag); } - if (! $quiet and ! $leaks_found) { + if (! $quiet and !$leaks_found and ! $tb->in_todo) { $tb->ok(1, sprintf "No leaks found at %s line %d", (caller())[1,2] ); } }