In vms/perlvms.pod :
Document traditional VMS behavior of C<die>, and also document the
latent POSIX_EXIT behavior changes for C<die> and C<$?>.
In perl.c:
Fixes to generate both the traditional and latent POSIX_EXIT VMS
behaviors and provide comments about why they are so different from
non-VMS. This needed a new macro STATUS_EXIT_SET in perl.h.
In perl.h:
Fixes to generate the expected VMS exit status for the various ways that
it could be set.
New macro STATUS_EXIT_SET to differentiate the cases, for non-VMS made
it reference STATUS_UNIX_SET.
In vms/vms.c:
Fix #1, default operator precedence in C was different than what I
intended, so child exit status codes were translated incorrectly.
Fix #2, typo caused a UNIX status code translation be changed to the
wrong code.
A test was run last night and all the tests that exercised this code passed.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/vms/perlvms.pod Tue Oct 25 05:05:13 2005
+++ vms/perlvms.pod Tue Oct 25 10:36:35 2005
@@ -626,6 +626,24 @@
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,11 +1088,24 @@
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 $|
--- /rsync_root/perl/perl.c Tue Oct 25 04:57:15 2005
+++ perl.c Tue Oct 25 09:52:09 2005
@@ -5154,7 +5154,7 @@
STATUS_ALL_FAILURE;
break;
default:
- STATUS_UNIX_EXIT_SET(status);
+ STATUS_EXIT_SET(status);
break;
}
my_exit_jump();
@@ -5166,15 +5166,57 @@
#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;
--- /rsync_root/perl/perl.h Tue Oct 25 04:57:16 2005
+++ perl.h Tue Oct 25 10:41:23 2005
@@ -2642,26 +2642,28 @@
# define STATUS_UNIX_SET(n) \
STMT_START { \
I32 evalue = (I32)n; \
- PL_statusvalue = evalue; \
+ PL_statusvalue = evalue; \
if (PL_statusvalue != -1) { \
- if (PL_statusvalue != EVMSERR) { \
- PL_statusvalue &= 0xFFFF; \
- PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \
- } \
- else { \
- PL_statusvalue_vms = vaxc$errno; \
- } \
+ if (PL_statusvalue != EVMSERR) { \
+ PL_statusvalue &= 0xFFFF; \
+ if (MY_POSIX_EXIT) \
+ PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\
+ else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \
+ } \
+ else { \
+ PL_statusvalue_vms = vaxc$errno; \
+ } \
} \
- else PL_statusvalue_vms = SS$_ABORT; \
- set_vaxc_errno(evalue); \
+ else PL_statusvalue_vms = SS$_ABORT; \
+ set_vaxc_errno(PL_statusvalue_vms); \
} STMT_END
/* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets
* 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, anything other than 0 indicates
- * a native status should be set to the failure code SS$_ABORT;
+ * 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
@@ -2686,7 +2688,8 @@
PL_statusvalue_vms = \
(C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
(STS$K_ERROR | STS$M_INHIB_MSG) : 0); \
- else PL_statusvalue_vms = SS$_ABORT; \
+ else \
+ 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; \
@@ -2698,6 +2701,33 @@
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 \
@@ -2754,6 +2784,7 @@
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)
--- /rsync_root/perl/vms/vms.c Tue Oct 25 05:05:17 2005
+++ vms/vms.c Tue Oct 25 09:52:37 2005
@@ -1821,7 +1821,7 @@
fac_sp = vms_status & STS$M_FAC_SP;
msg_no = vms_status & (STS$M_MSG_NO | STS$M_SEVERITY);
- if ((facility == 0) || (fac_sp == 0) && (child_flag == 0)) {
+ if (((facility == 0) || (fac_sp == 0)) && (child_flag == 0)) {
switch(msg_no) {
case SS$_NORMAL:
unix_status = 0;
@@ -2025,7 +2025,7 @@
case EACCES: return SS$_FILACCERR;
case EFAULT: return SS$_ACCVIO;
/* case ENOTBLK */
- case EBUSY: SS$_DEVOFFLINE;
+ case EBUSY: return SS$_DEVOFFLINE;
case EEXIST: return RMS$_FEX;
/* case EXDEV */
case ENODEV: return SS$_NOSUCHDEV;
