The attached t/pmc/signal.t should send a SIGINT to a sleeping or looping PASM test. This basically works, but the test output looks a bit ugly:
t/pmc/signal............# No tests run!
t/pmc/signal............ok 1/2# Looks like you planned 2 tests but only ran 1.
t/pmc/signal............ok
It seems, that due to the fork, the test system is getting an empty test result too.
$ perl -Ilib t/pmc/signal.t 1..2 # No tests run! ok 1 - SIGINT event - sleep # Looks like you planned 2 tests but only ran 1. ok 2 - SIGINT event - loop
Perl and test hackers please help, leo
#! perl -w
use Parrot::Test;
use Test::More;
if ($^O eq 'linux') {
plan tests => 2;
}
else {
plan skip_all => 'No events yet';
}
#
# Fork a process, that sends a SIGINT to parrot
# This is a non-portable hack. It also prints one comment line:
# # No tests run!
# from the other process.
#
sub send_SIGINT {
my $code = shift;
$SIG{CHLD} = sub { wait; };
my $pid = fork;
die "fork failed $!" unless (defined $pid);
if ($pid) {
# parent - run test
&$code;
}
else {
# wait a bit - could be too short on slower ordinateurs.
select undef, undef, undef, 0.5;
# now get PID of parrot
my @ps = `ps | grep [p]arrot`;
die 'no output from ps' unless @ps;
# the IO thread parrot process
# on 2.2.x there are 4 processes, last is the IO thread
my $io_thread = pop @ps;
if ($io_thread =~ /^\s*(\d+)/) {
$pid = $1;
# send a SIGINT
kill 2, $pid;
}
else {
die 'no pid found for parrot';
}
exit(0);
}
}
send_SIGINT(
sub { output_is(<<'CODE', <<'OUTPUT', "SIGINT event - sleep") } );
print "start\n"
# no exception handler - parrot should die silently
sleep 1
print "never\n"
end
CODE
start
OUTPUT
send_SIGINT(
sub { output_is(<<'CODE', <<'OUTPUT', "SIGINT event - loop") } );
bounds 1 # no JIT
print "start\n"
# no exception handler - parrot should die silently
lp: dec I20
if I20, lp
print "never\n"
end
CODE
start
OUTPUT
