Skip to content
This repository
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 161 lines (128 sloc) 2.976 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
#! perl
# Copyright (C) 2001-2008, 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.

=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 "ps" command isn't one of the portable ones.

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

if ( $platforms{$^O} ) {

    #plan tests => 3;
    plan skip_all => 'Signals currently disabled';
}
else {
    plan skip_all => 'No events yet';
}

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

my $pid;

sub parrot_pids {
    grep { !/harness/ && !/sh -c/ } `ps axw | 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 =~ /^\s*(\d+)/ && $1 == $pid ) {
        ok( 0, "parrot $pid still running" );
    }
    else {
        ok( 1, 'parrot stopped' );
    }
}

send_SIGHUP;

pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - sleep" );
    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" );
    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 );
    send_SIGHUP;

    pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - sleep, catch" );
    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:
Something went wrong with that request. Please try again.