X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F52leaks.t;h=b395483dcf34c1e644d1119c55c49132d725fa9c;hb=8aae794001ecccdb26c2bbd1b92c97bba9e65d79;hp=e54df310ebcff8cd234c6197796e4a2ad38c80ae;hpb=18a2903b824e3d3159836c99c1ab88058537169f;p=dbsrgits%2FDBIx-Class.git diff --git a/t/52leaks.t b/t/52leaks.t index e54df31..b395483 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -59,6 +59,7 @@ my $has_dt; # Skip the heavy-duty leak tracing when just doing an install # or when having Moose crap all over everything +# FIXME - remove when Replicated gets off Moose if ( !$ENV{DBICTEST_VIA_REPLICATED} and !DBICTest::RunMode->is_plain ) { # redefine the bless override so that we can catch each and every object created @@ -89,15 +90,26 @@ if ( !$ENV{DBICTEST_VIA_REPLICATED} and !DBICTest::RunMode->is_plain ) { return populate_weakregistry ($weak_registry, $obj ); }; - require Try::Tiny; - for my $func (qw/try catch finally/) { - my $orig = \&{"Try::Tiny::$func"}; - *{"Try::Tiny::$func"} = sub (&;@) { + + for my $func (qw( dbic_internal_try dbic_internal_catch )) { + my $orig = \&{"DBIx::Class::_Util::$func"}; + *{"DBIx::Class::_Util"} = sub (&;@) { populate_weakregistry( $weak_registry, $_[0] ); goto $orig; } } + if ( eval { require Try::Tiny } ) { + for my $func (qw( try catch finally )) { + my $orig = \&{"Try::Tiny::$func"}; + *{"Try::Tiny::$func"} = sub (&;@) { + populate_weakregistry( $weak_registry, $_[0] ); + goto $orig; + } + } + } + + # Some modules are known to install singletons on-load # Load them and empty the registry @@ -107,6 +119,7 @@ if ( !$ENV{DBICTEST_VIA_REPLICATED} and !DBICTest::RunMode->is_plain ) { require DBI; require DBD::SQLite; require Moo; + require Math::BigInt; %$weak_registry = (); } @@ -459,6 +472,15 @@ for my $addr (keys %$weak_registry) { delete $weak_registry->{$addr} unless $cleared->{bheos_pptiehinthashfieldhash}++; } + elsif ( + $names =~ /^Data::Dumper/m + and + $weak_registry->{$addr}{stacktrace} =~ /\bDBIx::Class::SQLMaker::Util::lax_serialize\b/ + ) { + # only clear one object of a specific behavior - more would indicate trouble + delete $weak_registry->{$addr} + unless $cleared->{dd_lax_serializer}++; + } elsif ($names =~ /^DateTime::TimeZone::UTC/m) { # DT is going through a refactor it seems - let it leak zones for now delete $weak_registry->{$addr}; @@ -536,6 +558,7 @@ SKIP: { if modver_gt_or_eq_and_lt( 'Test::More', '1.200', '1.301001_099' ); local $ENV{DBICTEST_IN_PERSISTENT_ENV} = 1; + local $ENV{DBICTEST_ANFANG_DEFANG} = 1; require File::Spec;