use
if
DBIx::Class::_ENV_::BROKEN_FORK,
'threads'
;
my
$worker
=
sub
{
my
$fn
=
shift
;
if
(
my
@offenders
=
grep
{
$_
!~ m{DBIx/Class/(?:_Util|Carp)\.pm} }
grep
{
$_
=~ /(^|\/)DBI/ }
keys
%INC
) {
die
"Wtf - DBI* modules present in %INC: @offenders"
;
}
local
$SIG
{__WARN__} = sigwarn_silencer(
qr/\bdeprecated\b/
i );
require
( (
$fn
=~ m| t/lib/ (.+) |x )[0] );
return
42;
};
find({
wanted
=>
sub
{
return
unless
( -f
$_
and
$_
=~ /\.pm$/ );
if
(DBIx::Class::_ENV_::BROKEN_FORK) {
my
$t
= threads->create(
sub
{
$worker
->(
$_
) });
sleep
0.1;
is (
$t
->
join
, 42,
"Thread loading $_ did not finish successfully"
)
|| diag (
$t
->can(
'error'
) ?
$t
->error :
'threads.pm too old to retrieve the error :('
);
}
else
{
my
$pid
=
fork
();
if
(!
defined
$pid
) {
die
"fork failed: $!"
}
elsif
(!
$pid
) {
$worker
->(
$_
);
exit
0;
}
is (
waitpid
(
$pid
, 0),
$pid
,
"Fork $pid terminated sucessfully"
);
my
$ex
= $? >> 8;
is (
$ex
, 0,
"Loading $_ ($pid) exitted with $ex"
);
}
},
no_chdir
=> 1,
},
't/lib/DBICTest/Schema/'
);
done_testing;