File: safe.t

package info (click to toggle)
libsys-sigaction-perl 0.20-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 192 kB
  • ctags: 24
  • sloc: perl: 147; makefile: 2
file content (148 lines) | stat: -rw-r--r-- 4,664 bytes parent folder | download
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 when safe=>1.
         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;