X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F52leaks.t;h=ae96a217650fa91cef2f920a67f885daf8230259;hb=50841788d03e2342a00470eb2f458e717922615b;hp=c6b64c261ecfc1aaccfe5556f41e881604bad10f;hpb=4fb8d74ca2854557fbe912d91381f2e91ab101be;p=dbsrgits%2FDBIx-Class.git diff --git a/t/52leaks.t b/t/52leaks.t index c6b64c2..ae96a21 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -1,3 +1,5 @@ +BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } + # work around brain damage in PPerl (yes, it has to be a global) $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /\QUse of "goto" to jump into a construct is deprecated/ @@ -21,16 +23,17 @@ use strict; use warnings; use Test::More; -use lib qw(t/lib); -use DBICTest::RunMode; -use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs); -use Scalar::Util qw(weaken blessed reftype); -use DBIx::Class::_Util qw(hrefaddr sigwarn_silencer modver_gt_or_eq modver_gt_or_eq_and_lt); BEGIN { + require DBICTest::Util; plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test" - if DBIx::Class::_ENV_::PEEPEENESS; + if DBICTest::Util::PEEPEENESS(); } +use DBICTest::RunMode; +use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs); +use Scalar::Util qw(weaken blessed reftype); +use DBIx::Class::_Util qw(hrefaddr sigwarn_silencer modver_gt_or_eq modver_gt_or_eq_and_lt); +use DBIx::Class::Optional::Dependencies; my $TB = Test::More->builder; if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) { @@ -56,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 @@ -101,11 +105,10 @@ if ( !$ENV{DBICTEST_VIA_REPLICATED} and !DBICTest::RunMode->is_plain ) { # this loads the DT armada $has_dt = DBIx::Class::Optional::Dependencies->req_ok_for([qw( test_rdbms_sqlite ic_dt )]); - require Errno; require DBI; require DBD::SQLite; - require FileHandle; require Moo; + require Math::BigInt; %$weak_registry = (); } @@ -441,6 +444,10 @@ for my $addr (keys %$weak_registry) { # T::B 2.0 has result objects and other fancyness delete $weak_registry->{$addr}; } + # remove this when IO::Dir is gone from SQLT + elsif ($INC{"IO/Dir.pm"} and $names =~ /^Class::Struct::Tie_ISA/m) { + delete $weak_registry->{$addr}; + } elsif ($names =~ /^Hash::Merge/m) { # only clear one object of a specific behavior - more would indicate trouble delete $weak_registry->{$addr} @@ -531,6 +538,9 @@ 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; $persistence_tests = { PPerl => {