X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=f9a71af3b2dbe7f637ce73e76e0b09a3cfbad648;hb=6ac6a52b90121db9304782c76ae9243ce4205369;hp=e3354321b2bc6f29936a00cfc1d0295a6374e755;hpb=6e186fbe5e810b53fd043e653387f61258900a38;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index e335432..f9a71af 100644
--- a/perl.c
+++ b/perl.c
@@ -1773,6 +1773,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef PL_OP_SLAB_ALLOC
 			     " PL_OP_SLAB_ALLOC"
 #  endif
+#  ifdef SPRINTF_RETURNS_STRLEN
+			     " SPRINTF_RETURNS_STRLEN"
+#  endif
 #  ifdef THREADS_HAVE_PIDS
 			     " THREADS_HAVE_PIDS"
 #  endif
@@ -5154,7 +5157,7 @@ Perl_my_exit(pTHX_ U32 status)
 	STATUS_ALL_FAILURE;
 	break;
     default:
-	STATUS_UNIX_EXIT_SET(status);
+	STATUS_EXIT_SET(status);
 	break;
     }
     my_exit_jump();
@@ -5166,15 +5169,57 @@ Perl_my_failure_exit(pTHX)
 #ifdef VMS
      /* We have been called to fall on our sword.  The desired exit code
       * should be already set in STATUS_UNIX, but could be shifted over
-      * by 8 bits.  STATUS_UNIX_EXIT_SET will fix all cases where
-      * an error code has been set.
+      * by 8 bits.  STATUS_UNIX_EXIT_SET will handle the cases where a
+      * that code is set.
       *
       * If an error code has not been set, then force the issue.
       */
-    if (STATUS_UNIX == 0)   /* No errors or status recorded? */
-	STATUS_ALL_FAILURE; /* Ok, force the issue with a generic code */
-    else
-      STATUS_UNIX_EXIT_SET(STATUS_UNIX);
+    if (MY_POSIX_EXIT) {
+
+	/* In POSIX_EXIT mode follow Perl documentations and use 255 for
+	 * the exit code when there isn't an error.
+	 */
+
+	if (STATUS_UNIX == 0)
+	    STATUS_UNIX_EXIT_SET(255);
+	else {
+	    STATUS_UNIX_EXIT_SET(STATUS_UNIX);
+
+	    /* The exit code could have been set by $? or vmsish which
+	     * means that it may not be fatal.  So convert
+	     * success/warning codes to fatal.
+	     */
+	    if ((STATUS_NATIVE & (STS$K_SEVERE|STS$K_ERROR)) == 0)
+		STATUS_UNIX_EXIT_SET(255);
+	}
+    }
+    else {
+	/* Traditionally Perl on VMS always expects a Fatal Error. */
+	if (vaxc$errno & 1) {
+
+	    /* So force success status to failure */
+	    if (STATUS_NATIVE & 1)
+		STATUS_ALL_FAILURE;
+	}
+	else {
+	    if (!vaxc$errno) {
+		STATUS_UNIX = EINTR; /* In case something cares */
+		STATUS_ALL_FAILURE;
+	    }
+	    else {
+		int severity;
+		STATUS_NATIVE = vaxc$errno; /* Should already be this */
+
+		/* Encode the severity code */
+		severity = STATUS_NATIVE & STS$M_SEVERITY;
+		STATUS_UNIX = (severity ? severity : 1) << 8;
+
+		/* Perl expects this to be a fatal error */
+		if (severity != STS$K_SEVERE)
+		    STATUS_ALL_FAILURE;
+	    }
+	}
+    }
 
 #else
     int exitstatus;