X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F52leaks.t;h=da99c8b5e62eeb2fa376070c11d9192029b29022;hb=331886ef1b5ab7a732915b8213dd525a3ea63b88;hp=796453b1e9b13aadd6b258a92ef55fab3a729012;hpb=7be5717eb2be4fa484e665853777f1c10c6deced;p=dbsrgits%2FDBIx-Class.git diff --git a/t/52leaks.t b/t/52leaks.t index 796453b..da99c8b 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 { @@ -79,6 +80,10 @@ unless (DBICTest::RunMode->is_plain) { } ); + # unicode is tricky, and now we happen to invoke it early via a + # regex in connection() + return $obj if (ref $obj) =~ /^utf8/; + # Test Builder is now making a new object for every pass/fail (que bloat?) # and as such we can't really store any of its objects (since it will # re-populate the registry while checking it, ewwww!) @@ -107,6 +112,7 @@ unless (DBICTest::RunMode->is_plain) { require DBI; require DBD::SQLite; require FileHandle; + require Moo; %$weak_registry = (); } @@ -252,9 +258,12 @@ 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 + $rs_bind_circref->next; + require Storable; %$base_collection = ( %$base_collection, @@ -418,6 +427,12 @@ assert_empty_weakregistry ($weak_registry); # this is ugly and dirty but we do not yet have a Test::Embedded or # similar +# set up -I +require Config; +$ENV{PERL5LIB} = join ($Config::Config{path_sep}, @INC); +($ENV{PATH}) = $ENV{PATH} =~ /(.+)/; + + my $persistence_tests = { PPerl => { cmd => [qw/pperl --prefork=1/, __FILE__], @@ -442,10 +457,6 @@ SKIP: { skip 'Main test failed - skipping persistent env tests', 1 unless $TB->is_passing; - # set up -I - require Config; - local $ENV{PERL5LIB} = join ($Config::Config{path_sep}, @INC); - local $ENV{DBICTEST_IN_PERSISTENT_ENV} = 1; require IPC::Open2;