X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F52leaks.t;h=e5d498a5d25a8a401432b3059d50097de036ffac;hb=bf302897b5be1fe2e857b6be427dd66e82587547;hp=f3fcab59f8f45cd3085266dee85bec048bdc28a8;hpb=6ae62c5c162c519053b7354065b8f6c33e990b6e;p=dbsrgits%2FDBIx-Class.git diff --git a/t/52leaks.t b/t/52leaks.t index f3fcab5..e5d498a 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -47,10 +47,10 @@ 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 hrefaddr); +use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs); use Scalar::Util qw(weaken blessed reftype); use DBIx::Class; -use DBIx::Class::_Util 'sigwarn_silencer'; +use DBIx::Class::_Util qw(hrefaddr sigwarn_silencer); BEGIN { plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test" if DBIx::Class::_ENV_::PEEPEENESS; @@ -324,7 +324,7 @@ unless (DBICTest::RunMode->is_plain) { # do a heavy-duty fire-and-compare loop on all resultsets # this is expensive - not running on install my $typecounts = {}; - unless (DBICTest::RunMode->is_plain) { + unless (DBICTest::RunMode->is_plain or $ENV{DBICTEST_IN_PERSISTENT_ENV}) { # FIXME - ideally we should be able to just populate an alternative # registry, subtract everything from the main one, and arrive at @@ -360,13 +360,6 @@ unless (DBICTest::RunMode->is_plain) { ## anything we have seen so far is cool #delete @{$interim_wr}{keys %$weak_registry}; # - ## I still don't get any of this... - #delete $interim_wr->{$_} for grep { - # ref ($interim_wr->{$_}{weakref}) eq 'SCALAR' - # and - # ${$interim_wr->{$_}{weakref}} eq 'very closure... much wtf... wow!!!' - #} keys %$interim_wr; - # ## moment of truth - the rest ought to be gone #assert_empty_weakregistry($interim_wr); } @@ -458,6 +451,17 @@ for my $addr (keys %$weak_registry) { delete $weak_registry->{$addr} unless $cleared->{hash_merge_singleton}{$weak_registry->{$addr}{weakref}{behavior}}++; } + elsif ( + # if we can look at closed over pieces - we will register it as a global + !DBICTest::Util::LeakTracer::CV_TRACING + and + $names =~ /^SQL::Translator::Generator::DDL::SQLite/m + ) { + # SQLT::Producer::SQLite keeps global generators around for quoted + # and non-quoted DDL, allow one for each quoting style + delete $weak_registry->{$addr} + unless $cleared->{sqlt_ddl_sqlite}->{@{$weak_registry->{$addr}{weakref}->quote_chars}}++; + } } # FIXME !!!