From: Peter Rabbitson Date: Wed, 15 Jan 2014 15:19:54 +0000 (+0100) Subject: Even saner diagnostics (view under diff -w) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a44a267c141d38f2fe083db2a0354f912df3489;p=dbsrgits%2FDBIx-Class-Historic.git Even saner diagnostics (view under diff -w) Now that we no longer store signs of "ref X was here but GCed" there is no point in "No leaks of X" pass()es either --- diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm index 10dca61..794e83f 100644 --- a/t/lib/DBICTest/Util/LeakTracer.pm +++ b/t/lib/DBICTest/Util/LeakTracer.pm @@ -170,35 +170,38 @@ sub assert_empty_weakregistry { for my $addr (sort { $weak_registry->{$a}{display_name} cmp $weak_registry->{$b}{display_name} } keys %$weak_registry) { - ! defined $weak_registry->{$addr}{weakref} and next if $quiet; - - $tb->ok (! defined $weak_registry->{$addr}{weakref}, "No leaks of $weak_registry->{$addr}{display_name}") or do { - $leaks_found++; - - my $diag = do { - local $Data::Dumper::Maxdepth = 1; - sprintf "\n%s (refcnt %d) => %s\n", - $weak_registry->{$addr}{display_name}, - refcount($weak_registry->{$addr}{weakref}), - ( - ref($weak_registry->{$addr}{weakref}) eq 'CODE' - and - B::svref_2object($weak_registry->{$addr}{weakref})->XSUB - ) ? '__XSUB__' : Dumper( $weak_registry->{$addr}{weakref} ) - ; - }; - - $diag .= Devel::FindRef::track ($weak_registry->{$addr}{weakref}, 20) . "\n" - if ( $ENV{TEST_VERBOSE} && eval { require Devel::FindRef }); - - $diag =~ s/^/ /mg; - - if (my $stack = $weak_registry->{$addr}{stacktrace}) { - $diag .= " Reference first seen$stack"; - } - - $tb->diag($diag); + next if ! defined $weak_registry->{$addr}{weakref}; + + $leaks_found++; + $tb->ok (0, "Leaked $weak_registry->{$addr}{display_name}"); + + my $diag = do { + local $Data::Dumper::Maxdepth = 1; + sprintf "\n%s (refcnt %d) => %s\n", + $weak_registry->{$addr}{display_name}, + refcount($weak_registry->{$addr}{weakref}), + ( + ref($weak_registry->{$addr}{weakref}) eq 'CODE' + and + B::svref_2object($weak_registry->{$addr}{weakref})->XSUB + ) ? '__XSUB__' : Dumper( $weak_registry->{$addr}{weakref} ) + ; }; + + $diag .= Devel::FindRef::track ($weak_registry->{$addr}{weakref}, 20) . "\n" + if ( $ENV{TEST_VERBOSE} && eval { require Devel::FindRef }); + + $diag =~ s/^/ /mg; + + if (my $stack = $weak_registry->{$addr}{stacktrace}) { + $diag .= " Reference first seen$stack"; + } + + $tb->diag($diag); + } + + if (! $quiet and ! $leaks_found) { + $tb->ok(1, sprintf "No leaks found at %s line %d", (caller())[1,2] ); } }