From: Jarkko Hietaniemi Date: Tue, 19 Jul 2005 12:06:00 +0000 (+0300) Subject: allow POSIX SIGRTMIN...SIGRTMAX signals (and plug a core dump) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3609ea0df8ff1318cd5f51cdbcd9bcd6c2a3fce2;p=p5sagit%2Fp5-mst-13.2.git allow POSIX SIGRTMIN...SIGRTMAX signals (and plug a core dump) Message-ID: <42DCC278.2010009@gmail.com> p4raw-id: //depot/perl@25185 --- diff --git a/Configure b/Configure index c1eb2c0..bb3d9c5 100755 --- a/Configure +++ b/Configure @@ -26,7 +26,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Mon Jul 18 12:48:03 CEST 2005 [metaconfig 3.0 PL70] +# Generated on Tue Jul 19 13:22:25 CEST 2005 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.org) cat >c1$$ < 'POSIX', @libs, - MAN3PODS => {}, # Pods will be built by installman. - XSPROTOARG => '-noprototypes', # XXX remove later? + MAN3PODS => {}, # Pods will be built by installman. + XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'POSIX.pm', - realclean => {FILES=> 'const-c.inc const-xs.inc'}, + realclean => {FILES=> 'const-c.inc const-xs.inc'}, ); my @names = @@ -44,14 +44,15 @@ my @names = PARENB PARMRK PARODD PATH_MAX PIPE_BUF RAND_MAX R_OK SCHAR_MAX SCHAR_MIN SEEK_CUR SEEK_END SEEK_SET SHRT_MAX SHRT_MIN SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT - SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 - SIG_BLOCK SIG_SETMASK SIG_UNBLOCK SSIZE_MAX STDERR_FILENO STDIN_FILENO - STDOUT_FILENO STREAM_MAX S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO - S_IRWXU S_ISGID S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH - S_IXUSR TCIFLUSH TCIOFF TCIOFLUSH TCION TCOFLUSH TCOOFF TCOON - TCSADRAIN TCSAFLUSH TCSANOW TMP_MAX TOSTOP TZNAME_MAX VEOF VEOL VERASE - VINTR VKILL VMIN VQUIT VSTART VSTOP VSUSP VTIME WNOHANG WUNTRACED W_OK - X_OK _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT + SIGRTMAX SIGRTMIN SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU + SIGUSR1 SIGUSR2 SIG_BLOCK SIG_SETMASK SIG_UNBLOCK SSIZE_MAX + STDERR_FILENO STDIN_FILENO STDOUT_FILENO STREAM_MAX + S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID + S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR TCIFLUSH TCIOFF + TCIOFLUSH TCION TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW + TMP_MAX TOSTOP TZNAME_MAX VEOF VEOL VERASE VINTR VKILL VMIN VQUIT + VSTART VSTOP VSUSP VTIME WNOHANG WUNTRACED W_OK X_OK + _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX _PC_PIPE_BUF _PC_VDISABLE _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS _SC_STREAM_MAX _SC_TZNAME_MAX diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 8767621..8e58c04 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -1,6 +1,6 @@ package POSIX; -our(@ISA, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD) = (); +our(@ISA, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD, %SIGRT) = (); our $VERSION = "1.09"; @@ -56,6 +56,70 @@ package POSIX::SigAction; use AutoLoader 'AUTOLOAD'; sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0, SAFE => 0}, $_[0] } +package POSIX::SigRt; + +use strict; + +use Tie::Hash; +use base qw(Tie::StdHash); + +use POSIX qw(sigaction SIGRTMIN SIGRTMAX SA_RESTART); + +use vars qw($SIGACTION_FLAGS); + +$SIGACTION_FLAGS = 0; + +my $SIGRTMIN = &SIGRTMIN; +my $SIGRTMAX = &SIGRTMAX; +my $sigrtn = $SIGRTMAX - $SIGRTMIN; + +sub _croak { + die "POSIX::SigRt not available" unless defined $sigrtn && $sigrtn > 0; +} + +sub _getsig { + &_croak; + my $rtsig = $_[0]; + # Allow (SIGRT)?MIN( + n)?, a common idiom when doing these things in C. + $rtsig = $SIGRTMIN + ($1 || 0) + if $rtsig =~ /^(?:(?:SIG)?RT)?MIN(\s*\+\s*(\d+))?$/; + return $rtsig; +} + +sub _exist { + my $rtsig = _getsig($_[1]); + my $ok = $rtsig >= $SIGRTMIN && $rtsig <= $SIGRTMAX; + ($rtsig, $ok); +} + +sub _check { + my ($rtsig, $ok) = &_exist; + die "No POSIX::SigRt signal $_[1] (valid range SIGRTMIN..SIGRTMAX, or $SIGRTMIN..$SIGRTMAX)" + unless $ok; + return $rtsig; +} + +sub new { + my ($rtsig, $handler, $flags) = @_; + my $sigset = POSIX::SigSet->new($rtsig); + my $sigact = POSIX::SigAction->new($handler, + $sigset, + $flags); + sigaction($rtsig, $sigact); +} + +sub EXISTS { &_exist } +sub FETCH { my $rtsig = &_check; + my $oa = POSIX::SigAction->new(); + sigaction($rtsig, undef, $oa); + return $oa->{HANDLER} } +sub STORE { my $rtsig = &_check; new($rtsig, $_[2], $SIGACTION_FLAGS) } +sub DELETE { delete $SIG{ &_check } } +sub CLEAR { &_exist; delete @SIG{ SIGRTMIN .. SIGRTMAX } } +sub SCALAR { &_croak; $sigrtn + 1 } + +tie %POSIX::SIGRT, 'POSIX::SigRt'; + package POSIX; 1; @@ -812,10 +876,10 @@ sub load_imports { signal_h => [qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL - SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN - SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR - SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal - sigpending sigprocmask sigsuspend)], + SIGPIPE %SIGRT SIGRTMIN SIGRTMAX SIGQUIT SIGSEGV SIGSTOP + SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 + SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK + raise sigaction signal sigpending sigprocmask sigsuspend)], stdarg_h => [], @@ -963,3 +1027,4 @@ sub handler { $_[0]->{HANDLER} = $_[1] if @_ > 1; $_[0]->{HANDLER} }; sub mask { $_[0]->{MASK} = $_[1] if @_ > 1; $_[0]->{MASK} }; sub flags { $_[0]->{FLAGS} = $_[1] if @_ > 1; $_[0]->{FLAGS} }; sub safe { $_[0]->{SAFE} = $_[1] if @_ > 1; $_[0]->{SAFE} }; + diff --git a/ext/POSIX/POSIX.pod b/ext/POSIX/POSIX.pod index 1a09c69..147f2db 100644 --- a/ext/POSIX/POSIX.pod +++ b/ext/POSIX/POSIX.pod @@ -46,7 +46,7 @@ the standard distribution. It incorporates autoloading, namespace games, and dynamic loading of code that's in Perl, C, or both. It's a great source of wisdom. -=head1 CAVEATS +=head1 CAVEATS A few functions are not implemented because they are C specific. If you attempt to call these, they will print a message telling you that they @@ -770,7 +770,7 @@ You can also use or - sub log10 { log($_[0]) / 2.30258509299405 } + sub log10 { log($_[0]) / 2.30258509299405 } or @@ -798,21 +798,21 @@ malloc() is C-specific. Perl does memory management transparently. This is identical to the C function C. Perl does not have any support for the wide and multibyte -characters of the C standards, so this might be a rather +characters of the C standards, so this might be a rather useless function. =item mbstowcs This is identical to the C function C. Perl does not have any support for the wide and multibyte -characters of the C standards, so this might be a rather +characters of the C standards, so this might be a rather useless function. =item mbtowc This is identical to the C function C. Perl does not have any support for the wide and multibyte -characters of the C standards, so this might be a rather +characters of the C standards, so this might be a rather useless function. =item memchr @@ -1117,9 +1117,10 @@ will change only the real user identifier. =item sigaction -Detailed signal management. This uses C objects for the -C and C arguments. Consult your system's C -manpage for details. +Detailed signal management. This uses C objects for +the C and C arguments (the oldaction can also be +just a hash reference). Consult your system's C manpage +for details, see also C. Synopsis: @@ -1190,7 +1191,7 @@ See also L. This is functionally identical to Perl's builtin C function for suspending the execution of the current for process for certain -number of seconds, see L. There is one significant +number of seconds, see L. There is one significant difference, however: C returns the number of B seconds, while the C returns the number of slept seconds. @@ -1600,14 +1601,14 @@ builtin C function, see L. This is identical to the C function C. Perl does not have any support for the wide and multibyte -characters of the C standards, so this might be a rather +characters of the C standards, so this might be a rather useless function. =item wctomb This is identical to the C function C. Perl does not have any support for the wide and multibyte -characters of the C standards, so this might be a rather +characters of the C standards, so this might be a rather useless function. =item write @@ -1634,14 +1635,14 @@ See also L. =item new Creates a new C object which corresponds to the C -C. This object will be destroyed automatically when it is -no longer needed. The first parameter is the fully-qualified name of a sub -which is a signal-handler. The second parameter is a C -object, it defaults to the empty set. The third parameter contains the +C. This object will be destroyed automatically when +it is no longer needed. The first parameter is the handler, a sub +reference. The second parameter is a C object, it +defaults to the empty set. The third parameter contains the C, it defaults to 0. $sigset = POSIX::SigSet->new(SIGINT, SIGQUIT); - $sigaction = POSIX::SigAction->new( \&main::handler, $sigset, &POSIX::SA_NOCLDSTOP ); + $sigaction = POSIX::SigAction->new( \&handler, $sigset, &POSIX::SA_NOCLDSTOP ); This C object is intended for use with the C function. @@ -1680,6 +1681,57 @@ filled in when given as the third parameter to C: =back +=head2 POSIX::SigRt + +=over 8 + +=item %SIGRT + +A hash of the POSIX realtime signal handlers. It is an extension of +the standard %SIG, the $POSIX::SIGRT{SIGRTMIN} is roughly equivalent +to $SIG{SIGRTMIN}, but the right POSIX moves (see below) are made with +the POSIX::SigSet and POSIX::sigaction instead of accessing the %SIG. + +You can set the %POSIX::SIGRT elements to set the POSIX realtime +signal handlers, use C and C on the elements, and use +C on the C<%POSIX::SIGRT> to find out how many POSIX realtime +signals there are available (SIGRTMAX - SIGRTMIN + 1, the SIGRTMAX is +a valid POSIX realtime signal). + +Setting the %SIGRT elements is equivalent to calling this: + + sub new { + my ($rtsig, $handler, $flags) = @_; + my $sigset = POSIX:SigSet($rtsig); + my $sigact = POSIX::SigAction->new($handler, $sigset, $flags); + sigaction($rtsig, $sigact); + } + +The flags default to zero, if you want something different you can +either use C on $POSIX::RtSig::SIGACTION_FLAGS, or you can +derive from POSIX::SigRt and define your own C (the tied hash +STORE method of the %SIGRT calls C, +where the $rtsig ranges from zero to SIGRTMAX - SIGRTMIN + 1). + +Just as with any signal, you can use sigaction($rtsig, undef, $oa) to +retrieve the installed signal handler (or, rather, the signal action). + +B whether POSIX realtime signals really work in your system, or +whether Perl has been compiled so that it works with them, is outside +of this discussion. + +=item SIGRTMIN + +Return the minimum POSIX realtime signal number available, or C +if no POSIX realtime signals are available. + +=item SIGRTMAX + +Return the maximum POSIX realtime signal number available, or C +if no POSIX realtime signals are available. + +=back + =head2 POSIX::SigSet =over 8 diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 818e861..26d5e20 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -51,7 +51,7 @@ #include #endif -/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to +/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to metaconfig for future extension writers. We don't use them in POSIX. (This is really sneaky :-) --AD */ @@ -198,7 +198,7 @@ char *tzname[] = { "" , "" }; # ifndef HAS_MKFIFO # if defined(OS2) || defined(MACOS_TRADITIONAL) # define mkfifo(a,b) not_here("mkfifo") -# else /* !( defined OS2 ) */ +# else /* !( defined OS2 ) */ # ifndef mkfifo # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0)) # endif @@ -265,7 +265,7 @@ unsigned long strtoul (const char *, char **, int); #endif #endif #ifndef HAS_FPATHCONF -#define fpathconf(f,n) (SysRetLong) not_here("fpathconf") +#define fpathconf(f,n) (SysRetLong) not_here("fpathconf") #endif #ifndef HAS_MKTIME #define mktime(a) not_here("mktime") @@ -274,10 +274,10 @@ unsigned long strtoul (const char *, char **, int); #define nice(a) not_here("nice") #endif #ifndef HAS_PATHCONF -#define pathconf(f,n) (SysRetLong) not_here("pathconf") +#define pathconf(f,n) (SysRetLong) not_here("pathconf") #endif #ifndef HAS_SYSCONF -#define sysconf(n) (SysRetLong) not_here("sysconf") +#define sysconf(n) (SysRetLong) not_here("sysconf") #endif #ifndef HAS_READLINK #define readlink(a,b,c) not_here("readlink") @@ -1060,7 +1060,7 @@ localeconv() if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep) hv_store(RETVAL, "mon_thousands_sep", 17, newSVpv(lcbuf->mon_thousands_sep, 0), 0); -#endif +#endif #ifndef NO_LOCALECONV_MON_GROUPING if (lcbuf->mon_grouping && *lcbuf->mon_grouping) hv_store(RETVAL, "mon_grouping", 12, @@ -1259,6 +1259,7 @@ sigaction(sig, optaction, oldaction = 0) POSIX__SigSet sigset; SV** svp; SV** sigsvp; + if (sig == 0 && SvPOK(ST(0))) { const char *s = SvPVX_const(ST(0)); int i = whichsig(s); @@ -1274,6 +1275,13 @@ sigaction(sig, optaction, oldaction = 0) else sig = i; } +#ifdef NSIG + if (sig > NSIG) { /* NSIG - 1 is still okay. */ + Perl_warner(aTHX_ packWARN(WARN_SIGNAL), + "No such signal: %d", sig); + XSRETURN_UNDEF; + } +#endif sigsvp = hv_fetch(GvHVn(siggv), PL_sig_name[sig], strlen(PL_sig_name[sig]), diff --git a/ext/POSIX/t/sigaction.t b/ext/POSIX/t/sigaction.t index 38cde16..7ab6043 100644 --- a/ext/POSIX/t/sigaction.t +++ b/ext/POSIX/t/sigaction.t @@ -1,5 +1,7 @@ #!./perl +use Test::More tests => 29; + BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; @@ -17,12 +19,10 @@ BEGIN{ } use strict; -use vars qw/$bad7 $ok10 $bad18 $ok/; +use vars qw/$bad $bad7 $ok10 $bad18 $ok/; $^W=1; -print "1..25\n"; - sub IGNORE { $bad7=1; } @@ -42,37 +42,33 @@ my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0); my $bad; local($SIG{__WARN__})=sub { $bad=1; }; sigaction(SIGHUP, $newaction, $oldaction); - if($bad) { print "not ok 1\n" } else { print "ok 1\n"} + ok(!$bad, "no warnings"); } -if($oldaction->{HANDLER} eq 'DEFAULT' || - $oldaction->{HANDLER} eq 'IGNORE') - { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"} -print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n"; +ok($oldaction->{HANDLER} eq 'DEFAULT' || + $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER}); + +is($SIG{HUP}, '::foo'); sigaction(SIGHUP, $newaction, $oldaction); -if($oldaction->{HANDLER} eq '::foo') - { print "ok 4\n" } else { print "not ok 4\n"} -if($oldaction->{MASK}->ismember(SIGUSR1)) - { print "ok 5\n" } else { print "not ok 5\n"} -if($oldaction->{FLAGS}) { - if ($^O eq 'linux' || $^O eq 'unicos') { - print "ok 6 # Skip: sigaction() thinks different in $^O\n"; - } else { - print "not ok 6\n"; - } -} else { - print "ok 6\n"; +is($oldaction->{HANDLER}, '::foo'); + +ok($oldaction->{MASK}->ismember(SIGUSR1), "SIGUSR1 ismember MASK"); + +SKIP: { + skip("sigaction() thinks different in $^O", 1) + if $^O eq 'linux' || $^O eq 'unicos'; + is($oldaction->{FLAGS}, 0); } $newaction=POSIX::SigAction->new('IGNORE'); sigaction(SIGHUP, $newaction); kill 'HUP', $$; -print $bad7 ? "not ok 7\n" : "ok 7\n"; +ok(!$bad, "SIGHUP ignored"); -print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n"; +is($SIG{HUP}, 'IGNORE'); sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT')); -print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n"; +is($SIG{HUP}, 'DEFAULT'); $newaction=POSIX::SigAction->new(sub { $ok10=1; }); sigaction(SIGHUP, $newaction); @@ -80,9 +76,9 @@ sigaction(SIGHUP, $newaction); local($^W)=0; kill 'HUP', $$; } -print $ok10 ? "ok 10\n" : "not ok 10\n"; +ok($ok10, "SIGHUP handler called"); -print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n"; +is(ref($SIG{HUP}), 'CODE'); sigaction(SIGHUP, POSIX::SigAction->new('::foo')); # Make sure the signal mask gets restored after sigaction croak()s. @@ -92,36 +88,36 @@ eval { sigaction(SIGINT, $act); }; kill 'HUP', $$; -print $ok ? "ok 12\n" : "not ok 12\n"; +ok($ok, "signal mask gets restored after croak"); undef $ok; # Make sure the signal mask gets restored after sigaction returns early. my $x=defined sigaction(SIGKILL, $newaction, $oldaction); kill 'HUP', $$; -print !$x && $ok ? "ok 13\n" : "not ok 13\n"; +ok(!$x && $ok, "signal mask gets restored after early return"); $SIG{HUP}=sub {}; sigaction(SIGHUP, $newaction, $oldaction); -print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n"; +is(ref($oldaction->{HANDLER}), 'CODE'); eval { sigaction(SIGHUP, undef, $oldaction); }; -print $@ ? "not ok 15\n" : "ok 15\n"; +ok(!$@, "undef for new action"); eval { sigaction(SIGHUP, 0, $oldaction); }; -print $@ ? "not ok 16\n" : "ok 16\n"; +ok(!$@, "zero for new action"); eval { sigaction(SIGHUP, bless({},'Class'), $oldaction); }; -print $@ ? "ok 17\n" : "not ok 17\n"; +ok($@, "any object not good as new action"); -if ($^O eq 'VMS') { - print "ok 18 # Skip: SIGCONT not trappable in $^O\n"; -} else { +SKIP: { + skip("SIGCONT not trappable in $^O", 1) + if ($^O eq 'VMS'); $newaction=POSIX::SigAction->new(sub { $ok10=1; }); if (eval { SIGCONT; 1 }) { sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT')); @@ -130,7 +126,7 @@ if ($^O eq 'VMS') { kill 'CONT', $$; } } - print $bad18 ? "not ok 18\n" : "ok 18\n"; + ok(!$bad18, "SIGCONT trappable"); } { @@ -143,17 +139,17 @@ if ($^O eq 'VMS') { sub hup21 { $hup21++ } sigaction("FOOBAR", $newaction); - print "ok 19\n"; # no coredump, still alive + ok(1, "no coredump, still alive"); $newaction = POSIX::SigAction->new("hup20"); sigaction("SIGHUP", $newaction); kill "HUP", $$; - print $hup20 == 1 ? "ok 20\n" : "not ok 20\n"; + is($hup20, 1); $newaction = POSIX::SigAction->new("hup21"); sigaction("HUP", $newaction); kill "HUP", $$; - print $hup21 == 1 ? "ok 21\n" : "not ok 21\n"; + is ($hup21, 1); } # "safe" attribute. @@ -163,21 +159,34 @@ if ($^O eq 'VMS') { $SIG{HUP} = \&foo; $oldaction = POSIX::SigAction->new; sigaction(SIGHUP, undef, $oldaction); -print $oldaction->safe ? "ok 22\n" : "not ok 22\n"; +ok($oldaction->safe, "SIGHUP is safe"); # SigAction handling is not safe ... sigaction(SIGHUP, POSIX::SigAction->new(\&foo)); sigaction(SIGHUP, undef, $oldaction); -print $oldaction->safe ? "not ok 23\n" : "ok 23\n"; +ok(!$oldaction->safe, "SigAction not safe by default"); # ... unless we say so! $newaction = POSIX::SigAction->new(\&foo); $newaction->safe(1); sigaction(SIGHUP, $newaction); sigaction(SIGHUP, undef, $oldaction); -print $oldaction->safe ? "ok 24\n" : "not ok 24\n"; +ok($oldaction->safe, "SigAction can be safe"); # And safe signal delivery must work $ok = 0; kill 'HUP', $$; -print $ok ? "ok 25\n" : "not ok 25\n"; +ok($ok, "safe signal delivery must work"); + +SKIP: { + eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX)'; + skip("no SIGRT signals", 4) if $@; + ok(SIGRTMAX > SIGRTMIN, "SIGRTMAX > SIGRTMIN"); + is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT"); + my $sigrtmin; + my $h = sub { $sigrtmin = 1 }; + $SIGRT{SIGRTMIN} = $h; + is($SIGRT{SIGRTMIN}, $h, "handler set & get"); + kill 'SIGRTMIN', $$; + is($sigrtmin, 1, "SIGRTMIN handler works"); +} diff --git a/handy.h b/handy.h index 681290e..b712af3 100644 --- a/handy.h +++ b/handy.h @@ -24,7 +24,7 @@ /* =head1 Handy Values -=for apidoc AmU||Nullch +=for apidoc AmU||Nullch Null character pointer. =for apidoc AmU||Nullsv @@ -59,7 +59,7 @@ Null SV pointer. g++ can be identified by __GNUG__. Andy Dougherty February 2000 */ -#ifdef __GNUG__ /* GNU g++ has bool built-in */ +#ifdef __GNUG__ /* GNU g++ has bool built-in */ # ifndef HAS_BOOL # define HAS_BOOL 1 # endif @@ -122,11 +122,11 @@ Null SV pointer. For dealing with issues that may arise from various 32/64-bit systems, we will ask Configure to check out - SHORTSIZE == sizeof(short) - INTSIZE == sizeof(int) - LONGSIZE == sizeof(long) + SHORTSIZE == sizeof(short) + INTSIZE == sizeof(int) + LONGSIZE == sizeof(long) LONGLONGSIZE == sizeof(long long) (if HAS_LONG_LONG) - PTRSIZE == sizeof(void *) + PTRSIZE == sizeof(void *) DOUBLESIZE == sizeof(double) LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE). @@ -422,7 +422,7 @@ Converts the specified character to lowercase. # else -# define isALNUM_LC(c) (isascii(c) && (isalnum(c) || (c) == '_')) +# define isALNUM_LC(c) (isascii(c) && (isalnum(c) || (c) == '_')) # define isIDFIRST_LC(c) (isascii(c) && (isalpha(c) || (c) == '_')) # define isALPHA_LC(c) (isascii(c) && isalpha(c)) # define isSPACE_LC(c) (isascii(c) && isspace(c)) @@ -647,7 +647,7 @@ hopefully catches attempts to access uninitialized memory. * line number, and C function name if available) passed in. This info can * then be used for logging the calls, for which one gets a sample * implementation if PERL_MEM_LOG_STDERR is defined. - * + * * Known problems: * - all memory allocs do not get logged, only those * that go through Newx() and derivatives (while all @@ -759,10 +759,69 @@ Malloc_t Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int li #define pTHX__VALUE_ ,(void *)my_perl, #define pTHX__VALUE ,(void *)my_perl #else -#define pTHX_FORMAT +#define pTHX_FORMAT #define pTHX__FORMAT -#define pTHX_VALUE_ +#define pTHX_VALUE_ #define pTHX_VALUE -#define pTHX__VALUE_ +#define pTHX__VALUE_ #define pTHX__VALUE #endif /* USE_ITHREADS */ + +/* NSIG logic from Configure --> */ +/* Strange style to avoid deeply-nested #if/#else/#endif */ +#ifndef NSIG +# ifdef _NSIG +# define NSIG (_NSIG) +# endif +#endif + +#ifndef NSIG +# ifdef SIGMAX +# define NSIG (SIGMAX+1) +# endif +#endif + +#ifndef NSIG +# ifdef SIG_MAX +# define NSIG (SIG_MAX+1) +# endif +#endif + +#ifndef NSIG +# ifdef _SIG_MAX +# define NSIG (_SIG_MAX+1) +# endif +#endif + +#ifndef NSIG +# ifdef MAXSIG +# define NSIG (MAXSIG+1) +# endif +#endif + +#ifndef NSIG +# ifdef MAX_SIG +# define NSIG (MAX_SIG+1) +# endif +#endif + +#ifndef NSIG +# ifdef SIGARRAYSIZE +# define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */ +# endif +#endif + +#ifndef NSIG +# ifdef _sys_nsig +# define NSIG (_sys_nsig) /* Solaris 2.5 */ +# endif +#endif + +/* Default to some arbitrary number that's big enough to get most + of the common signals. +*/ +#ifndef NSIG +# define NSIG 50 +#endif +/* <-- NSIG logic from Configure */ +