1#!perl -w 2 3# We assume that TestInit has been used. 4 5BEGIN { 6 chdir 't' if -d 't'; 7 require './test.pl'; 8 skip_all_if_miniperl(); 9} 10 11use strict; 12use warnings; 13 14use Config; 15use Data::Dumper; 16$Data::Dumper::Sortkeys = 1; 17 18# Windows doesn't seem to be able to test signals. 19skip_all("Signals lock up tests on $^O") if $^O =~ /MSWin32/; 20 21$| = 1; 22 23# Extract the signals from %Config. 24my @SIGNAMES = split /\s+/, $Config{sig_name}; 25my @SIGNUMS = split /\s+/, $Config{sig_num}; 26 27my %SIG_MAP; 28foreach my $i ( 0 .. ( scalar @SIGNAMES - 1 ) ) { 29 $SIG_MAP{ $SIGNAMES[$i] } = $SIGNUMS[$i]; 30} 31 32# Find the canonical (first) signal names. 33my %CANONICAL_SIG; 34my @duplicate_signals; 35foreach my $sig (@SIGNAMES) { 36 my $signum = $SIG_MAP{$sig}; 37 $CANONICAL_SIG{$signum} //= $sig; 38 push @duplicate_signals, $sig if $CANONICAL_SIG{$signum} ne $sig; 39} 40 41plan tests => scalar @duplicate_signals * 5; 42watchdog(25); 43 44# Define the duplicate signal handlers. 45my $sent = ''; 46 47sub handler_is { 48 my $signame = shift; 49 my $signum = $SIG_MAP{$signame}; 50 51 my $canonical = $CANONICAL_SIG{$signum}; 52 53 is( $signame, $canonical, "Signal name for $sent is recieved as the canonical '$canonical' name." ); 54 55 return; 56} 57 58foreach my $dupe (@duplicate_signals) { 59 my $canonical_name = $CANONICAL_SIG{ $SIG_MAP{$dupe} }; 60 note "Testing $dupe / $canonical_name signal pair"; 61 { 62 local $SIG{$dupe} = \&handler_is; 63 is( $SIG{$dupe}, $SIG{$canonical_name}, "Both handlers for $canonical_name/$dupe are set" ); 64 65 $sent = $dupe; 66 kill $dupe, $$; 67 68 $sent = $canonical_name; 69 kill $canonical_name, $$; 70 } 71 72 is( $SIG{$dupe}, undef, "The signal $dupe is cleared after local goes out of scope." ); 73 is( $SIG{$canonical_name}, undef, "The signal $canonical_name is cleared after local goes out of scope." ); 74} 75 76