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
|
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl 1.t'
#lab: this could be a clone of mask.t. The idea would be to turn on safe
#signal handling and verify the same results. The problem is that it does
#not appear to work.
#
#########################
use Test::More ;
my $tests = 1;
#BEGIN { use_ok('Sys::SigAction') };
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
use strict;
#use warnings;
use Carp qw( carp cluck croak confess );
use Data::Dumper;
use POSIX ':signal_h' ;
use Sys::SigAction qw( set_sig_handler sig_name sig_number );
#from mask.t:
#see commends in mask.t for concept of this test...
##summary: the kills in sigHUP are masked, and execute only after
#sigHUP finished without interuption
my $hup = 0;
my $int = 0;
my $usr = 0;
my $cnt = 1;
sub sigHUP {
ok( ($cnt++ == 1) ,'sigHUP called (1)' );
kill INT => $$;
kill USR1 => $$;
$hup++;
sleep 1;
ok( ($cnt++==2) ,'sig mask delayed INT and USR1(2)' );
}
sub sigINT_1
{
#since USR1 is delayed by mask of USR1 on this Signal handler
#
ok( ($cnt==3) ,"sigINT_1 called(3) failure: ($cnt!=3) this should have been delayed by mask until sigHUP finished" );
$cnt++;
$int++;
sleep 1;
ok( ($cnt++==4) ,"sig mask delayed USR1 (signaled from sigHUP)(4)" );
}
sub sigUSR_1 {
ok( ($cnt==5) ,"sigUSR called (5) failure: ($cnt!=5) it should have been delayed by mask until sigHUP finished)" );
$cnt++;
$usr++;
}
#end included functions from mask.t ...
SKIP: {
# if ($] <5.008)
# {
# plan skip_all => "using the safe attribute requires perl 5.8.2 or later";
# }
if ( ($] <5.008002) )
{
$tests += 3;
plan tests => $tests;
ok( 1, "NOTE: using the safe attribute requires perl 5.8.2 or later" );
eval {
local $SIG{__WARN__} = sub { die $_[0]; };
my $h = set_sig_handler( sig_number(SIGALRM) ,sub { die "Timeout!"; }, { safe =>0 } );
};
#print STDERR "\ntest 2: \$\@ = '$@'\n";
ok( $@ eq '', "safe=>0 got no warning in \$\@ = '$@'" );
eval {
local $SIG{__WARN__} = sub { die $_[0]; };
my $h = set_sig_handler( sig_number(SIGALRM) ,sub { die "Timeout!"; }, { safe =>1 } );
};
ok( $@ ne '' ,"safe=>1 expected warning in \$\@ = '$@'" );
eval {
local $SIG{__WARN__} = sub { die $_[0]; };
my $h = set_sig_handler( sig_number(SIGALRM) ,sub { die "Timeout!"; } );
};
ok( $@ eq "", "safe not set: no warning in \$\@ = '$@'" );
}
else # ($] >= 5.008002 )
{
if ( ! $ENV{SAFE_T} ) #setting safe mode breaks masked signals
{
plan tests => $tests;
print STDERR "
NOTE: Setting safe=>1... with masked signals does not seem to work.
The problem is that the masked signals are not masked, but when
safe=>0 they are.
If you have an application for safe=>1 and can come up with
a test that works in the context of this module's installation
please send me a patch to safe.t that tests it.
See the block below this one... which if executed would test safe mode
with masked signals... it is a clone of part of mask.t that proves this
is broken.
Lincoln
\n";
ok( 1, "skipping test of safe flag for now" );
}
else
{
#including mask.t here testing with masked signals...
$tests = 6;
plan tests => $tests;
#testing again with safe on
#set_sig_handler( 'HUP' ,\&sigHUP ,{ flags => SA_RESTART, mask=>[ qw( INT USR1 ) ] , safe=>1 } );
#set_sig_handler( 'INT' ,\&sigINT_1 ,{ flags => SA_RESTART, mask=>[ qw( USR1 )] ,safe=>1 } );
#set_sig_handler( 'USR1' ,\&sigUSR_1 ,{ flags => SA_RESTART, safe=>1 } );
set_sig_handler( 'HUP' ,\&sigHUP ,{ flags => SA_RESTART, mask=>[ qw( INT USR1 ) ] , safe=>1 } );
set_sig_handler( 'INT' ,\&sigINT_1 ,{ flags => SA_RESTART, mask=>[ qw( USR1 )] ,safe=>1 } );
set_sig_handler( 'USR1' ,\&sigUSR_1 ,{ flags => SA_RESTART, safe=>1 } );
kill HUP => $$;
ok( ( $cnt++==6 ), "reached 6th test after first kill" );
#lab ok( ($hup==1 ), "hup=1 ($hup)" );
#lab ok( ($int==1 ), "int=1 ($int)" );
#lab ok( ($usr==1 ), "usr=1 ($usr)" );
}
}
}
#ok( $int ,'sigINT called' );
#ok( $usr ,"sigUSR called $usr" );
exit;
|