delete $weak_registry->{$addr}
unless $cleared->{hash_merge_singleton}{$weak_registry->{$addr}{weakref}{behavior}}++;
}
+ elsif ($names =~ /^B::Hooks::EndOfScope::PP::_TieHintHashFieldHash/m) {
+ # there is one tied lexical which stays alive until GC time
+ # https://metacpan.org/source/ETHER/B-Hooks-EndOfScope-0.15/lib/B/Hooks/EndOfScope/PP/FieldHash.pm#L24
+ # simply ignore it here, instead of teaching the leaktracer to examine ties
+ # the latter is possible yet terrible: https://github.com/dbsrgits/dbix-class/blob/v0.082820/t/lib/DBICTest/Util/LeakTracer.pm#L113-L117
+ delete $weak_registry->{$addr}
+ unless $cleared->{bheos_pptiehinthashfieldhash}++;
+ }
+ elsif ($names =~ /^DateTime::TimeZone::UTC/m) {
+ # DT is going through a refactor it seems - let it leak zones for now
+ delete $weak_registry->{$addr};
+ }
elsif (
# # if we can look at closed over pieces - we will register it as a global
# !DBICTest::Util::LeakTracer::CV_TRACING
($ENV{PATH}) = $ENV{PATH} =~ /(.+)/;
-my $persistence_tests = {
- PPerl => {
- cmd => [qw/pperl --prefork=1/, __FILE__],
- },
- 'CGI::SpeedyCGI' => {
- cmd => [qw/speedy -- -t5/, __FILE__],
- },
-};
-
-# scgi is smart and will auto-reap after -t amount of seconds
-# pperl needs an actual killer :(
-$persistence_tests->{PPerl}{termcmd} = [
- $persistence_tests->{PPerl}{cmd}[0],
- '--kill',
- @{$persistence_tests->{PPerl}{cmd}}[ 1 .. $#{$persistence_tests->{PPerl}{cmd}} ],
-];
-
+my $persistence_tests;
SKIP: {
skip 'Test already in a persistent loop', 1
if $ENV{DBICTEST_IN_PERSISTENT_ENV};
local $ENV{DBICTEST_IN_PERSISTENT_ENV} = 1;
+ $persistence_tests = {
+ PPerl => {
+ cmd => [qw/pperl --prefork=1/, __FILE__],
+ },
+ 'CGI::SpeedyCGI' => {
+ cmd => [qw/speedy -- -t5/, __FILE__],
+ },
+ };
+
+ # scgi is smart and will auto-reap after -t amount of seconds
+ # pperl needs an actual killer :(
+ $persistence_tests->{PPerl}{termcmd} = [
+ $persistence_tests->{PPerl}{cmd}[0],
+ '--kill',
+ @{$persistence_tests->{PPerl}{cmd}}[ 1 .. $#{$persistence_tests->{PPerl}{cmd}} ],
+ ];
+
require IPC::Open2;
for my $type (keys %$persistence_tests) { SKIP: {
# just an extra precaution in case we blew away from the SKIP - since there are no
# PID files to go by (man does pperl really suck :(
END {
- unless ($ENV{DBICTEST_IN_PERSISTENT_ENV}) {
- close $_ for (*STDIN, *STDOUT, *STDERR);
+ if ($persistence_tests->{PPerl}{termcmd}) {
local $?; # otherwise test will inherit $? of the system()
- system (@{$persistence_tests->{PPerl}{termcmd}})
- if $persistence_tests->{PPerl}{termcmd};
+ require IPC::Open3;
+ open my $null, ">", File::Spec->devnull;
+ waitpid(
+ IPC::Open3::open3(undef, $null, $null, @{$persistence_tests->{PPerl}{termcmd}}),
+ 0,
+ );
}
}