Not quite so relicy as thought in #11651 (op/concat #4 and #5
[p5sagit/p5-mst-13.2.git] / vms / vms.c
index 581e7d4..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
 
@@ -3507,7 +3528,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
            {
            if (j+1 >= argc)
                {
-               PerlIO_printf(Perl_debug_log,"No input file after < on command line");
+               fprintf(stderr,"No input file after < on command line");
                exit(LIB$_WRONUMARG);
                }
            in = argv[++j];
@@ -3522,7 +3543,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
            {
            if (j+1 >= argc)
                {
-               PerlIO_printf(Perl_debug_log,"No output file after > on command line");
+               fprintf(stderr,"No output file after > on command line");
                exit(LIB$_WRONUMARG);
                }
            out = argv[++j];
@@ -3542,7 +3563,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
                out = 1 + ap;
            if (j >= argc)
                {
-               PerlIO_printf(Perl_debug_log,"No output file after > or >> on command line");
+               fprintf(stderr,"No output file after > or >> on command line");
                exit(LIB$_WRONUMARG);
                }
            continue;
@@ -3564,7 +3585,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
                    err = 2 + ap;
            if (j >= argc)
                {
-               PerlIO_printf(Perl_debug_log,"No output file after 2> or 2>> on command line");
+               fprintf(stderr,"No output file after 2> or 2>> on command line");
                exit(LIB$_WRONUMARG);
                }
            continue;
@@ -3573,7 +3594,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
            {
            if (j+1 >= argc)
                {
-               PerlIO_printf(Perl_debug_log,"No command into which to pipe on command line");
+               fprintf(stderr,"No command into which to pipe on command line");
                exit(LIB$_WRONUMARG);
                }
            cmargc = argc-(j+1);
@@ -3604,7 +3625,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
        {
        if (out != NULL)
            {
-           PerlIO_printf(Perl_debug_log,"'|' and '>' may not both be specified on command line");
+           fprintf(stderr,"'|' and '>' may not both be specified on command line");
            exit(LIB$_INVARGORD);
            }
        pipe_and_fork(aTHX_ cmargv);
@@ -3623,7 +3644,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
        /* Input from a pipe, reopen it in binary mode to disable       */
        /* carriage control processing.                                 */
 
-       fgetname(stdin, mbxname);
+       fgetname(stdin, mbxname);
        mbxnam.dsc$a_pointer = mbxname;
        mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);     
        lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0);
@@ -3637,18 +3658,18 @@ mp_getredirection(pTHX_ int *ac, char ***av)
        freopen(mbxname, "rb", stdin);
        if (errno != 0)
            {
-           PerlIO_printf(Perl_debug_log,"Can't reopen input pipe (name: %s) in binary mode",mbxname);
+           fprintf(stderr,"Can't reopen input pipe (name: %s) in binary mode",mbxname);
            exit(vaxc$errno);
            }
        }
     if ((in != NULL) && (NULL == freopen(in, "r", stdin, "mbc=32", "mbf=2")))
        {
-       PerlIO_printf(Perl_debug_log,"Can't open input file %s as stdin",in);
+       fprintf(stderr,"Can't open input file %s as stdin",in);
        exit(vaxc$errno);
        }
     if ((out != NULL) && (NULL == freopen(out, outmode, stdout, "mbc=32", "mbf=2")))
        {       
-       PerlIO_printf(Perl_debug_log,"Can't open output file %s as stdout",out);
+       fprintf(stderr,"Can't open output file %s as stdout",out);
        exit(vaxc$errno);
        }
        if (out != NULL) Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT",out);
@@ -3661,7 +3682,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
        FILE *tmperr;
        if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2")))
            {
-           PerlIO_printf(Perl_debug_log,"Can't open error file %s as stderr",err);
+           fprintf(stderr,"Can't open error file %s as stderr",err);
            exit(vaxc$errno);
            }
            fclose(tmperr);