From 5c2d7af2a41ad0642e7ae40c61d42000f908a0e0 Mon Sep 17 00:00:00 2001 From: "Craig A. Berry" Date: Fri, 22 Jun 2001 05:08:35 -0500 Subject: [PATCH] sigaction workaround for VMS Message-Id: p4raw-id: //depot/perl@10827 --- vms/vms.c | 21 +++++++++++++++++++++ vms/vmsish.h | 11 +++++++++++ 2 files changed, 32 insertions(+) diff --git a/vms/vms.c b/vms/vms.c index 406276d..548d130 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -1064,6 +1064,27 @@ my_tmpfile(void) } /*}}}*/ + +#ifndef HOMEGROWN_POSIX_SIGNALS +/* + * The C RTL's sigaction fails to check for invalid signal numbers so we + * help it out a bit. The docs are correct, but the actual routine doesn't + * do what the docs say it will. + */ +/*{{{int Perl_my_sigaction (pTHX_ int, const struct sigaction*, struct sigaction*);*/ +int +Perl_my_sigaction (pTHX_ int sig, const struct sigaction* act, + struct sigaction* oact) +{ + if (sig == SIGKILL || sig == SIGSTOP || sig == SIGCONT) { + SETERRNO(EINVAL, SS$_INVARG); + return -1; + } + return sigaction(sig, act, oact); +} +/*}}}*/ +#endif + /* default piping mailbox size */ #define PERL_BUFSIZ 512 diff --git a/vms/vmsish.h b/vms/vmsish.h index 7f4a3b3..93af772 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -492,6 +492,14 @@ struct utimbuf { # define sa_mask sv_mask # define sigsuspend(set) sigpause(*set) # define sigpending(a) (not_here("sigpending"),0) +#else +/* + * The C RTL's sigaction fails to check for invalid signal numbers so we + * help it out a bit. + */ +# ifndef DONT_MASK_RTL_CALLS +# define sigaction(a,b,c) Perl_my_sigaction(a,b,c) +# endif #endif /* VMS doesn't use a real sys_nerr, but we need this when scanning for error @@ -747,6 +755,9 @@ char * my_gconvert (double, int, int, char *); int Perl_kill_file (pTHX_ char *); int Perl_my_chdir (pTHX_ char *); FILE * Perl_my_tmpfile (); +#ifndef HOMEGROWN_POSIX_SIGNALS +int Perl_my_sigaction (pTHX_ int, const struct sigaction*, struct sigaction*); +#endif int Perl_my_utime (pTHX_ char *, struct utimbuf *); void Perl_vms_image_init (int *, char ***); struct dirent * Perl_readdir (pTHX_ DIR *); -- 1.8.3.1