I think I have most of this untangled, except somewhere I am missing a
critical step which is showing up in two tests.
The attached patches get me to this point, which is close, but obviously
not good enough.
It appears in these two tests, the exit handling is working in the
expected UNIX behavior, and not what Perl on VMS is used to doing.
For backwards compatibility, this behavior needs to be restored.
As near as I can tell, some VMS specific processing about changing $? in
an END block got changed, but I am not sure where to look in the code
for it.
EAGLE> MCR Sys$Disk:[]Perl. "-I[-.lib]" "[-.t.run]exit.t
1..16
[successful tests removed]
not ok 16 - Changing $? in END block
# Failed at [-.t.run]exit.t line 143
# got '2'
# expected '4'
Which the code that is failing is:
$exit_arg = 42;
$exit = run("END { \$? = $exit_arg }");
$exit_arg = (44 & 7) if $^O eq 'VMS';
is( $exit >> 8, $exit_arg, 'Changing $? in END block' );
The severity for 42 is "ERROR" and apparently on VMS, changing the
status to that in the end block should cause an exit code of 44.
But with out the END block, the exit code of 42 should be passed
through. I have that case working.
I have not figured out where this is failing, but I suspect it is the
same issue.
EAGLE> MCR Sys$Disk:[]Perl. "-I[-.blib.lib]" "-I[-.lib]" "-I[-.t.lib]"
[.lib.Test.Simple.sample_tests]too_few.plx
EAGLE> show sym $status
$STATUS == "%X000000FF"
The status should be 44. FF is being converted to the native success
status of 1 and UNIX status of 0 by the parent copy of Perl when this is
run in the full test.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/vms/vms.c Sun Oct 23 18:47:43 2005
+++ vms/vms.c Sun Oct 23 18:29:56 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;
--- /rsync_root/perl/perl.h Thu Oct 20 19:08:48 2005
+++ perl.h Mon Oct 24 01:24:20 2005
@@ -2632,26 +2632,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, status of one is set to the
+ * failure code of SS$_ABORT. Any other number is passed through.
*
* 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
@@ -2676,7 +2678,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 = (evalue == 1)? SS$_ABORT : evalue; \
} else { /* forgive them Perl, for they have sinned */ \
if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \
else PL_statusvalue_vms = vaxc$errno; \
--- /rsync_root/perl/perl.c Sun Oct 23 06:47:13 2005
+++ perl.c Mon Oct 24 00:35:36 2005
@@ -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;
