This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sigaction workaround for VMS
authorCraig A. Berry <craigberry@mac.com>
Fri, 22 Jun 2001 10:08:35 +0000 (05:08 -0500)
committerJarkko Hietaniemi <jhi@iki.fi>
Fri, 22 Jun 2001 14:15:26 +0000 (14:15 +0000)
Message-Id: <a05101001b75908704194@[192.168.56.145]>

p4raw-id: //depot/perl@10827

vms/vms.c
vms/vmsish.h

index 406276d..548d130 100644 (file)
--- 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
 
index 7f4a3b3..93af772 100644 (file)
@@ -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 *);