t/pmc/signal.t

   1 #! perl
   2 # Copyright (C) 2001-2008, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Test;
  10
  11 =head1 NAME
  12
  13 t/pmc/signal.t - Signal Handling
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/signal.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests signal handling.
  22
  23 =cut
  24
  25 # actually more platforms should work - all POSIX compliant ones
  26 # a second problem is to get the test doing the right thing: mainly figuring
  27 # out what PID to kill. The "ps" command isn't one of the portable ones.
  28
  29 my %platforms = map { $_ => 1 } qw/
  30     darwin
  31     hpux
  32     linux
  33     cygwin
  34     /;
  35
  36 if ( $platforms{$^O} ) {
  37
  38     #plan tests => 3;
  39     plan skip_all => 'Signals currently disabled';
  40 }
  41 else {
  42     plan skip_all => 'No events yet';
  43 }
  44
  45 #
  46 # A SIGHUP is sent to parrot from the alarm handler
  47 # This is a non-portable hack.
  48
  49 my $pid;
  50
  51 sub parrot_pids {
  52     grep { !/harness/ && !/sh -c/ } `ps axw | grep '[p]arrot'`;
  53 }
  54
  55 sub send_SIGHUP {
  56     $SIG{ALRM} = sub {
  57
  58         # get PID of parrot
  59         my @ps = parrot_pids;
  60         die 'no output from ps' unless @ps;
  61
  62         # the IO thread parrot process
  63         # on linux 2.2.x there are 4 processes, last is the IO thread
  64         # posix compliant threads have exactly one PID for parrot
  65         my $io_thread = pop @ps;
  66         if ( $io_thread =~ /^\s*(\d+)/ ) {
  67             $pid = $1;
  68
  69             # send a
  70             kill 'SIGHUP', $pid;
  71         }
  72         else {
  73             die 'no pid found for parrot';
  74         }
  75     };
  76     alarm 1;
  77 }
  78
  79 sub check_running {
  80     select undef, undef, undef, 0.1;
  81     my @ps     = parrot_pids;
  82     my $thread = pop @ps;
  83     if ( $thread =~ /^\s*(\d+)/ && $1 == $pid ) {
  84         ok( 0, "parrot $pid still running" );
  85     }
  86     else {
  87         ok( 1, 'parrot stopped' );
  88     }
  89 }
  90
  91 send_SIGHUP;
  92
  93 pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - sleep" );
  94     print "start\n"
  95     # no exception handler - parrot should die silently
  96     sleep 2
  97     print "never\n"
  98     end
  99 CODE
 100 start
 101 OUTPUT
 102
 103 # check_running;
 104
 105 send_SIGHUP;
 106
 107 pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - loop" );
 108     bounds 1 # no JIT
 109     print "start\n"
 110     # no exception handler - parrot should die silently
 111
 112 lp: dec I20
 113     if I20, lp
 114     # if 4G loops take less then 1 second, this will fail :)
 115     print "never\n"
 116     end
 117 CODE
 118 start
 119 OUTPUT
 120
 121 # check_running;
 122
 123 SKIP: {
 124     skip( "works standalone but not in test", 1 );
 125     send_SIGHUP;
 126
 127     pasm_output_is( <<'CODE', <<'OUTPUT', "SIGHUP event - sleep, catch" );
 128     push_eh _handler
 129     print "start\n"
 130     sleep 2
 131     print "never\n"
 132     end
 133 _handler:
 134 .include "signal.pasm"
 135     print "catched "
 136     set I0, P5["type"]
 137     neg I0, I0
 138     ne I0, .SIGHUP, nok
 139     print "SIGHUP\n"
 140     end
 141 nok:
 142     print "something _type = "
 143     neg I0, I0
 144     print I0
 145     print "\n"
 146     end
 147
 148 CODE
 149 start
 150 catched SIGHUP
 151 OUTPUT
 152
 153     # check_running;
 154 }
 155
 156 # Local Variables:
 157 #   mode: cperl
 158 #   cperl-indent-level: 4
 159 #   fill-column: 100
 160 # End:
 161 # vim: expandtab shiftwidth=4: