signal.t

#! perl
# Copyright (C) 2001-2014, Parrot Foundation.

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Test;

=head1 NAME

t/pmc/signal.t - Signal Handling

=head1 SYNOPSIS

    % prove t/pmc/signal.t

=head1 DESCRIPTION

Tests signal handling. These tests are very instable, but do work manually.

=cut

# actually more platforms should work - all POSIX compliant ones
# a second problem is to get the test doing the right thing: mainly figuring
# out what PID to kill. The "kill" and "ps" commands aren't one of the portable ones.


my %platforms = map { $_ => 1 } qw/
    darwin
    hpux
    linux
    cygwin
    /;

if ( $platforms{$^O} ) {
    #plan tests => 6;
    #$ENV{DYLD_LIBRARY_PATH} = "" if $^O eq 'darwin';
    plan skip_all => 'signal tests too instable in parallel, run it alone';
}
else {
    plan skip_all => 'Missing portable getpid and kill';
}

#
# A SIGHUP is sent to parrot from the alarm handler
# This is a non-portable hack.

my $pid;

sub parrot_pids {
    grep { !/harness/ && !/ Z / && !/sh -c/ && !/ \(/}
         `ps | grep '[p]arrot'`;
}

sub send_SIGHUP {
    $SIG{ALRM} = sub {

        # get PID of parrot
        my @ps = parrot_pids;
        die 'no output from ps' unless @ps;

        # the IO thread parrot process
        # on linux 2.2.x there are 4 processes, last is the IO thread
        # posix compliant threads have exactly one PID for parrot
        my $io_thread = pop @ps;
        if ( $io_thread =~ /^\s*(\d+)/ ) {
            $pid = $1;
            # send a
            kill 'SIGHUP', $pid;
        }
        else {
            die 'no pid found for parrot';
        }
    };
    alarm 1;
}

sub check_running {
    select undef, undef, undef, 0.1;
    my @ps     = parrot_pids;
    my $thread = pop @ps;
    if ( $thread and $thread =~ /^\s*(\d+)/ and $1 == $pid ) {
        ok( 0, "parrot $pid still running" );
    }
    else {
        ok( 1, 'parrot stopped' );
    }
}

send_SIGHUP;

pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - sleep", todo => 'instable signal tests');
    print "start\n"
    # no exception handler - parrot should die silently
    sleep 2
    print "never\n"
    end
CODE
start
OUTPUT

check_running;

send_SIGHUP;

pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - loop", todo => 'instable signal tests');
    # bounds 1 # no JIT
    print "start\n"
    # no exception handler - parrot should die silently

lp: dec I20
    if I20, lp
    # if 4G loops take less then 1 second, this will fail :)
    print "never\n"
    end
CODE
start
OUTPUT

check_running;

SKIP: {
    skip( "works standalone but not in test", 1 ) if 0;
    send_SIGHUP;

    pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - sleep, catch", todo => 'instable signal tests' );
    push_eh _handler
    print "start\n"
    sleep 2
    print "never\n"
    end
_handler:
.include "signal.pasm"
    print "catched "
    set I0, P5["type"]
    neg I0, I0
    ne I0, .SIGHUP, nok
    print "SIGHUP\n"
    end
nok:
    print "something _type = "
    neg I0, I0
    print I0
    print "\n"
    end

CODE
start
catched SIGHUP
OUTPUT

    check_running;
}

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4: