X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F52leaks.t;h=9f8c71a8c2f2464c180d8a07a7b67480d64576b6;hb=dbcd18a7224e70a2b1fe0a369397819569376c85;hp=a5ad0850a9d41596d61a9f53398e2211c2a746b4;hpb=76031e147d6f0d80ab3ec73a12d373962ade1252;p=dbsrgits%2FDBIx-Class.git diff --git a/t/52leaks.t b/t/52leaks.t index a5ad085..9f8c71a 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 qw/populate_weakregistry assert_empty_weakregistry/; +use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/; +use Scalar::Util 'refaddr'; use DBIx::Class; use B 'svref_2object'; BEGIN { @@ -111,6 +112,7 @@ unless (DBICTest::RunMode->is_plain) { require DBI; require DBD::SQLite; require FileHandle; + require Moo; %$weak_registry = (); } @@ -256,9 +258,14 @@ my @compose_ns_classes; leaky_resultset => $rs_bind_circref, leaky_resultset_cond => $cond_rowobj, - leaky_resultset_member => $rs_bind_circref->next, }; + # 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); + require Storable; %$base_collection = ( %$base_collection, @@ -295,7 +302,15 @@ my @compose_ns_classes; SKIP: { if ( DBIx::Class::Optional::Dependencies->req_ok_for ('test_leaks') ) { - Test::Memory::Cycle::memory_cycle_ok ($base_collection, 'No cycles in the object collection') + my @w; + local $SIG{__WARN__} = sub { $_[0] =~ /\QUnhandled type: REGEXP/ ? push @w, @_ : warn @_ }; + + Test::Memory::Cycle::memory_cycle_ok ($base_collection, 'No cycles in the object collection'); + + if ( $] > 5.011 ) { + local $TODO = 'Silence warning due to RT56681'; + is (@w, 0, 'No Devel::Cycle emitted warnings'); + } } else { skip 'Circular ref test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_leaks'), 1; @@ -353,28 +368,17 @@ for my $slot (keys %$weak_registry) { # Moo keeps globals around, this is normal delete $weak_registry->{$slot}; } - elsif ($slot =~ /^SQL::Translator/) { - # SQLT is a piece of shit, leaks all over - delete $weak_registry->{$slot}; + elsif ($slot =~ /^SQL::Translator::Generator::DDL::SQLite/) { + # SQLT::Producer::SQLite keeps global generators around for quoted + # and non-quoted DDL, allow one for each quoting style + delete $weak_registry->{$slot} + unless $cleared->{sqlt_ddl_sqlite}->{@{$weak_registry->{$slot}{weakref}->quote_chars}}++; } elsif ($slot =~ /^Hash::Merge/) { # 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 =~ /^Data::Dumper/ - and - $weak_registry->{$slot}{stacktrace} =~ /\QDBIx::Class::ResultSource::RowParser::_mk_row_parser/ - ) { - # there should be only one D::D object (used to construct the rowparser) - # more would indicate trouble - delete $weak_registry->{$slot} - unless $cleared->{mk_row_parser_dd_singleton}++; - } - elsif (DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT and $slot =~ /^__TxnScopeGuard__FIXUP__/) { - delete $weak_registry->{$slot} - } elsif ($slot =~ /^DateTime::TimeZone/) { # DT is going through a refactor it seems - let it leak zones for now delete $weak_registry->{$slot}; @@ -414,15 +418,16 @@ for my $moniker ( keys %{DBICTest::Schema->source_registrations || {}} ) { # 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: # -# $cond_object --> result_source --> schema --> storage --> $dbh --> {cached_kids} +# $cond_object --> result_source --> schema --> storage --> $dbh --> {CachedKids} # ^ / # \-------- bound value on prepared/cached STH <-----------/ # -TODO: { - local $TODO = 'Not sure how to fix this yet, an entanglment could be an option'; - my $r = $weak_registry->{'basic leaky_resultset_cond'}{weakref}; - ok(! defined $r, 'We no longer leak!') - or $r->result_source(undef); +{ + local $TODO = 'This fails intermittently - see RT#82942'; + if ( my $r = $weak_registry->{'basic leaky_resultset_cond'}{weakref} ) { + ok(! defined $r, 'Self-referential RS conditions no longer leak!') + or $r->result_source(undef); + } } assert_empty_weakregistry ($weak_registry); @@ -467,8 +472,11 @@ SKIP: { require IPC::Open2; for my $type (keys %$persistence_tests) { SKIP: { - skip "$type module not found", 1 - unless eval "require $type"; + unless (eval "require $type") { + # Don't terminate what we didn't start + delete $persistence_tests->{$type}{termcmd}; + skip "$type module not found", 1; + } my @cmd = @{$persistence_tests->{$type}{cmd}}; @@ -512,6 +520,7 @@ END { unless ($ENV{DBICTEST_IN_PERSISTENT_ENV}) { close $_ for (*STDIN, *STDOUT, *STDERR); local $?; # otherwise test will inherit $? of the system() - system (@{$persistence_tests->{PPerl}{termcmd}}); + system (@{$persistence_tests->{PPerl}{termcmd}}) + if $persistence_tests->{PPerl}{termcmd}; } }