Back out change #25839, and apply :

diff --git a/perl.c b/perl.c

index 9f8e385..f9a71af 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -5157,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();
diff --git a/perl.h b/perl.h

index 5a2a771..d6ccfa4 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2662,8 +2662,8 @@ typedef pthread_key_t     perl_key;
    * the NATIVE error status based on it.  It does not assume that
    * the UNIX/POSIX exit codes have any relationship to errno, except
    * that 0 indicates a success.  When in the default mode to comply
-   * with the Perl VMS documentation, status of one is set to the
-   * failure code of SS$_ABORT.  Any other number is passed through.
+   * with the Perl VMS documentation, any other code sets the NATIVE
+   * status to a failure code of SS$_ABORT.
    *
    * In the new POSIX EXIT mode, native status will be set so that the
    * actual exit code will can be retrieved by the calling program or
@@ -2689,7 +2689,7 @@ typedef pthread_key_t     perl_key;
                       (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
                        (STS$K_ERROR | STS$M_INHIB_MSG) : 0); \
                  else                                  \
-                   PL_statusvalue_vms = (evalue == 1)? SS$_ABORT : evalue; \
+                   PL_statusvalue_vms = SS$_ABORT; \
              } else { /* forgive them Perl, for they have sinned */ \
                if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \
                else PL_statusvalue_vms = vaxc$errno;           \
@@ -2701,6 +2701,33 @@ typedef pthread_key_t    perl_key;
            set_vaxc_errno(PL_statusvalue_vms);                 \
        } STMT_END
 
+  /* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code
+   * and sets the NATIVE error status based on it.  This special case
+   * is needed to maintain compatibility with past VMS behavior.
+   *
+   * In the default mode on VMS, this number is passed through as
+   * both the NATIVE and UNIX status.  Which makes it different
+   * that the STATUS_UNIX_EXIT_SET.
+   *
+   * In the new POSIX EXIT mode, native status will be set so that the
+   * actual exit code will can be retrieved by the calling program or
+   * shell.
+   *
+   */
+
+#   define STATUS_EXIT_SET(n)                          \
+       STMT_START {                                    \
+           I32 evalue = (I32)n;                        \
+           PL_statusvalue = evalue;                    \
+           if (MY_POSIX_EXIT)                          \
+               PL_statusvalue_vms =                    \
+                 (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
+                  (STS$K_ERROR | STS$M_INHIB_MSG) : 0); \
+           else                                        \
+               PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \
+           set_vaxc_errno(PL_statusvalue_vms);         \
+       } STMT_END
+
 
  /* This macro forces a success status */
 #   define STATUS_ALL_SUCCESS  \
@@ -2757,6 +2784,7 @@ typedef pthread_key_t     perl_key;
                PL_statusvalue &= 0xFFFF;       \
        } STMT_END
 #   define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n)
+#   define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n)
 #   define STATUS_CURRENT STATUS_UNIX
 #   define STATUS_EXIT STATUS_UNIX
 #   define STATUS_ALL_SUCCESS  (PL_statusvalue = 0, PL_statusvalue_posix = 0)
diff --git a/vms/perlvms.pod b/vms/perlvms.pod

index 685e39c..bf2b27d 100644 (file)
--- a/vms/perlvms.pod
+++ b/vms/perlvms.pod
@@ -626,6 +626,24 @@ C<crypt> to insure that you'll get the proper value:
         return 1;
     }
 
+
+=item die
+
+C<die> will force the native VMS exit status to be an SS$_ABORT code
+if neither of the $! or $? status values are ones that would cause
+the native status to be interpreted as being what VMS classifies as
+SEVERE_ERROR severity for DCL error handling.
+
+When the future POSIX_EXIT mode is active, C<die>, the native status
+code will be set to VMS condition value that will allow C programs
+including the GNV package to automatically decode the original C<$!>
+or <$?> or <$^E> settings unless those are all success values, in
+which case it will be set for those programs to recover the value
+255.  If at the time C<die> is called, the native VMS status value
+is either of SEVERE_ERROR or ERROR severity, the native VMS
+value will be used.  See C<$?> for a description on decoding the
+native VMS value to recover the original exit status.
+
 =item dump
 
 Rather than causing Perl to abort and dump core, the C<dump>
@@ -1070,12 +1088,25 @@ is that setting C<$?> to zero results in the generic success value
 SS$_NORMAL, and setting C<$?> to a non-zero value results in the
 generic failure status SS$_ABORT.  See also L<perlport/exit>.
 
+With the future POSIX_EXIT mode set, setting C<$?> will cause the
+code set to be encoded into a native VMS status code so that the
+either the parent or child exit codes of 0 to 255 can be recovered
+by C programs expecting _POSIX_EXIT behavior.  If both a parent
+and a child exit code are set, then it will be assumed that this
+is a VMS status code to be passed through.  The special code of
+0xFFFF is almost a NOOP as it will cause the current native
+VMS status in the C library to become the current native Perl
+VMS status.
+
 The pragma C<use vmsish 'status'> makes C<$?> reflect the actual 
 VMS exit status instead of the default emulation of POSIX status 
 described above.  This pragma also disables the conversion of
 non-zero values to SS$_ABORT when setting C<$?> in an END
 block (but zero will still be converted to SS$_NORMAL).
 
+Do not use the pragma C<use vmsish 'status'> with the future
+POSIX_EXIT mode, as they are requesting conflicting actions.
+
 =item $|
 
 Setting C<$|> for an I/O stream causes data to be flushed
perl.c		patch \| blob \| blame \| history
perl.h		patch \| blob \| blame \| history
vms/perlvms.pod		patch \| blob \| blame \| history