#!/usr/local/bin/perl -w my @custom_inc; BEGIN { if ($ENV{PERL_CORE}) { chdir 't' if -d 't'; @custom_inc = @INC = '../lib'; } elsif (!grep /blib/, @INC) { chdir 't' if -d 't'; unshift @INC, (@custom_inc = ('../blib/lib', '../blib/arch')); } } BEGIN {delete $ENV{THREADS_DEBUG}} # no debugging during testing! no if $] >= 5.008, warnings => 'threads'; use forks; # must be done _before_ Test::More which loads real threads.pm use forks::shared; diag( <new->reset; } } # Patch Test::Builder to add fork-thread awareness { no warnings 'redefine'; my $_sanity_check_old = \&Test::Builder::_sanity_check; *Test::Builder::_sanity_check = sub { my $self = $_[0]; # Don't bother with an ending if this is a forked copy. Only the parent # should do the ending. if( $self->{Original_Pid} != $$ ) { return; } $_sanity_check_old->(@_); }; } use Test::More tests => 3; use strict; use warnings; my $thr = threads->new(sub { while (1) { sleep 1; } }); sleep 3; $thr->kill('TERM'); sleep 3; ok(!$thr->is_running(), 'Check that thread is no longer running'); my $gotsig : shared = 0; $thr = threads->new(sub { $SIG{TERM} = sub { $gotsig = 1; CORE::exit(); }; while (1) { sleep 1; } }); sleep 3; $thr->kill('TERM'); sleep 3; ok(!$thr->is_running(), 'Check that thread is no longer running'); ok($gotsig, 'Check that custom signal handler was used'); foreach (threads->list()) { $_->join() if $_->is_joinable; #check before join, in case target system has non-standard/reliable signal behavior } 1;