t/pmc/signal.t

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