The previous fixes that I submitted did not get all of the cases that
were broken, and in a few cases contributed to the breakage.
This patch restores the documented and expected behavior for
VMS exit handling, and hopefully explains it a little better.
In t/op/exec.t:
Restore it back to what it was before I change it to match the incorrect
behavior of Perl.
In mg.c:
When VMSISH status is set, and modifying $? then it call the
STATUS_NATIVE_CHILD_SET so that the VMS exit status is set as expected.
Otherwise use the STATUS_UNIX_EXIT_SET which can be used to set either a
child exit status or a UNIX error status, with the expected matching
VMS status set.
In vms/perlvms.pod:
Change the slang term "logicals" to the more correct term "logical names".
Add a comment about unlink() behavior being compliant with what Posix
expects so that VMS users will understand why it is different than what
they are use to.
Update the documentation for $? handling to be more exact. And to
document a previously undocumented feature of $! error messages related
to $? that the Perl test scripts expect.
In Perl.c:
Fix up the Perl_my_failure_exit code to only override the native status
value if it is a success, and do it in a way that also supports the
POSIX_EXIT mode when a method for setting it is determined.
In Perl.h:
Nothing is now using STATUS_NATIVE_SET, so it is gone.
Document why STATUS_NATIVE_CHILD_SET does the complex things that it is
doing. Please no one break it, it took me quite a while to figure out
how to get it to always produce the expected values for $? and $!.
Fix bugs in STATUS_NATIVE_CHILD_SET so that it follows both what Perl
documents as existing behavior, supports the _POSIX_EXIT mode that
C programs ported from UNIX should be using, and the previously
undocumented setup of the $! string.
Fix bugs in STATUS_UNIX_EXIT_SET so that it will not generate the
expected VMS status codes for either a parent errno value or a child
status code, and support outputting _POSIX_EXIT codes when desired.
In vms.c:
Add cases for handling different severity levels for the SS$_ABORT
status code so that the expected $! string will be generated for the tests.
To do:
There needs to be a more prominent warning somewhere that setting
logical names with the ENV hash is different than what is normally
expected by VMS programs that do so. VMS programmers new to Perl will
tend to expect that new or superseded logical names will only be put in
the Process table, so will naturally get surprised when the changes
show up in other tables.
I just was not sure where to put that or how to word it.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/t/op/exec.t Thu Oct 20 05:02:20 2005
+++ t/op/exec.t Tue Oct 18 11:27:27 2005
@@ -90,14 +90,13 @@
'Explicit exit of 1' );
$rc = system { "lskdfj" } "lskdfj";
-$rc = 256 if ($rc == 5632) && $Is_VMS;
unless( ok($rc == 255 << 8 or $rc == -1 or $rc == 256 or $rc == 512) ) {
print "# \$rc == $rc\n";
}
unless ( ok( $! == 2 or $! =~ /\bno\b.*\bfile/i or
$! == 13 or $! =~ /permission denied/i or
- $! == 22 or $! =~ /invalid argument/ ) ) {
+ $! == 22 or $! =~ /invalid argument/ ) ) {
printf "# \$! eq %d, '%s'\n", $!, $!;
}
--- /rsync_root/perl/mg.c Thu Oct 20 04:56:15 2005
+++ mg.c Thu Oct 20 13:34:05 2005
@@ -2397,10 +2397,10 @@
#endif
#ifdef VMSISH_STATUS
if (VMSISH_STATUS)
- STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
+ STATUS_NATIVE_CHILD_SET((U32)SvIV(sv));
else
#endif
- STATUS_UNIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ STATUS_UNIX_EXIT_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '!':
{
--- /rsync_root/perl/vms/perlvms.pod Thu Oct 20 05:05:05 2005
+++ vms/perlvms.pod Thu Oct 20 17:33:09 2005
@@ -195,14 +195,14 @@
documentation provides more details.
Perl is now in the process of evolving to follow the setting of
-the DECC$* feature logicals in the interpretation of UNIX pathnames.
+the DECC$* feature logical names in the interpretation of UNIX pathnames.
This is still a work in progress.
For handling extended characters, and case sensitivity, as long as
DECC$POSIX_COMPLIANT_PATHNAMES, DECC$FILENAME_UNIX_REPORT, and
DECC$FILENAME_UNIX_ONLY are not set, then the older Perl behavior
for conversions of file specifications from UNIX to VMS is followed,
-except that VMS paths with concealed rooted logicals are now
+except that VMS paths with concealed rooted logical names are now
translated correctly to UNIX paths.
With those features set, then new routines may handle the translation,
@@ -271,7 +271,7 @@
the state, and not the $^O setting.
For consistency, when the above feature is clear and when not
-otherwise overridden by DECC feature logicals, most Perl routines
+otherwise overridden by DECC feature logical names, most Perl routines
return file specifications using lower case letters only,
regardless of the case used in the arguments passed to them.
(This is true only when running under VMS; Perl respects the
@@ -562,7 +562,7 @@
specification without an explicit directory (e.g. C<DUA1:>), as
well as if passed a directory.
-There are DECC feature logicals AND ODS-5 volume attributes that
+There are DECC feature logical names AND ODS-5 volume attributes that
also control what values are returned for the date fields.
Note: Some sites have reported problems when using the file-access
@@ -812,6 +812,9 @@
in midstream, the file may be left intact, but with a changed ACL
allowing you delete access.
+This behavior of C<unlink> is to be compatible with POSIX behavior
+and not traditional VMS behavior.
+
=item utime LIST
Since ODS-2, the VMS file structure for disk files, does not keep
@@ -968,7 +971,7 @@
DELETE/LOGICAL *
You can imagine how bad things would be if, for example, the SYS$MANAGER
-or SYS$SYSTEM logicals were deleted.
+or SYS$SYSTEM logical names were deleted.
At present, the first time you iterate over %ENV using
C<keys>, or C<values>, you will incur a time penalty as all
@@ -977,12 +980,13 @@
won't be as slow, but they also won't reflect any changes
to logical name tables caused by other programs.
-You do need to be careful with the logicals representing process-permanent
-files, such as C<SYS$INPUT> and C<SYS$OUTPUT>. The translations for these
-logicals are prepended with a two-byte binary value (0x1B 0x00) that needs to
be
-stripped off if you want to use it. (In previous versions of Perl it wasn't
-possible to get the values of these logicals, as the null byte acted as an
-end-of-string marker)
+You do need to be careful with the logical names representing
+process-permanent files, such as C<SYS$INPUT> and C<SYS$OUTPUT>.
+The translations for these logical names are prepended with a
+two-byte binary value (0x1B 0x00) that needs to be stripped off
+if you wantto use it. (In previous versions of Perl it wasn't
+possible to get the values of these logical names, as the null
+byte acted as an end-of-string marker)
=item $!
@@ -1026,8 +1030,9 @@
on a normal exit.
With the _POSIX_EXIT macro set, the exit code of zero is represented
-as 1, and the values from 1 to 255 are encoded by the equation
-VMS_status = 0x35a000 + (exit_code * 8).
+as 1, and the values from 2 to 255 are encoded by the equation
+VMS_status = 0x35a000 + (exit_code * 8) + 1. And in the special
+case of value 1, VMS_status = 0x35a000 + 8 + 2 + 0x10000000.
For other termination statuses, the severity portion of the
subprocess' exit status: if the severity was success or
@@ -1052,6 +1057,11 @@
call traditional VMS programs will be expecting the previous behavior.
And success is always the code 0.
+
+When the actual VMS termination status of the child is an error,
+internally the C<$!> value will be set to the closest UNIX code to
+that error so that Perl scripts that test for error messages will
+see the expected UNIX style error message instead of a VMS message.
Conversely, when setting C<$?> in an END block, an attempt is made
to convert the POSIX value into a native status intelligible to
--- /rsync_root/perl/perl.c Thu Oct 20 04:57:13 2005
+++ perl.c Tue Oct 18 17:49:31 2005
@@ -5165,16 +5165,18 @@
Perl_my_failure_exit(pTHX)
{
#ifdef VMS
- if (vaxc$errno & 1) {
- if (STATUS_NATIVE & 1) /* fortuitiously includes "-1" */
- STATUS_NATIVE_SET(44);
- }
- else {
- if (!vaxc$errno) /* unlikely */
- STATUS_NATIVE_SET(44);
- else
- STATUS_NATIVE_SET(vaxc$errno);
- }
+ /* We have been called to die on our sword. The desired exit code
+ * should be already set in STATUS_UNIX, but could be shifted over
+ * over by 8 bits. STATUS_UNIX_EXIT_SET will fix all cases where
+ * an error code has been 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);
+
#else
int exitstatus;
if (errno & 255)
--- /rsync_root/perl/perl.h Thu Oct 20 04:57:14 2005
+++ perl.h Thu Oct 20 14:58:41 2005
@@ -390,7 +390,7 @@
#define DOSISH 1
#endif
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__)
|| defined(__cplusplus) || defined(EPOC) || defined(NETWARE) ||
defined(__SYMBIAN32__)
+#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) ||
defined(__cplusplus) || defined(EPOC) || defined(NETWARE) ||
defined(__SYMBIAN32__)
# define STANDARD_C 1
#endif
@@ -2574,24 +2574,29 @@
(((I32)PL_statusvalue_vms == -1 ? SS$_ABORT : PL_statusvalue_vms) | \
(VMSISH_HUSHED ? STS$M_INHIB_MSG : 0))
-/* STATUS_NATIVE_SET - takes a NATIVE status code and converts it to a
- * UNIX/POSIX status value and updates both the native and PL_statusvalue
- * as needed. This currently seems only exist for VMS and is used in the exit
- * handling.
- */
-
-# define STATUS_NATIVE_SET(n) STATUS_NATIVE_SET_PORC(n, 0)
-/* STATUS_NATIVE_CHILD_SET - same as STATUS_NATIVE_SET, but shifts the UNIX
- * value over the correct number of bits to be a child status. Usually
- * the number of bits is 8, but that could be platform dependent. The NATIVE
- * status code is presumed to have either from a child process.
+/* STATUS_NATIVE_CHILD_SET - Calculate UNIX status that matches the child
+ * exit code and shifts the UNIX value over the correct number of bits to
+ * be a child status. Usually the number of bits is 8, but that could be
+ * platform dependent. The NATIVE status code is presumed to have either
+ * from a child process.
*/
-# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET_PORC(n, 1)
+/* This is tangled up bad. The child processes return a true native VMS
+ status which must be saved. But there is an assumption in Perl that
+ the UNIX child status has some relationship to errno values, so
+ Perl tries to translate it to text in some of the tests.
+ In order to get the string translation correct, for the error, errno
+ must be EVMSERR, but that generates a different text message
+ than what the test programs are expecting. So an errno value must
+ be derived at from the native status value when an error occurs.
+ That will hide the true native status message. With this version of
+ perl, the true native child status can always be retrieved so that
+ is not a problem. But in this case, Plstatusvalue and errno may
+ have different values in them.
+ */
- /* internal convert VMS status codes to UNIX error or status codes */
-# define STATUS_NATIVE_SET_PORC(n, _x) \
+# define STATUS_NATIVE_CHILD_SET(n) \
STMT_START { \
I32 evalue = (I32)n; \
if (evalue == EVMSERR) { \
@@ -2599,14 +2604,16 @@
PL_statusvalue = evalue; \
} else { \
PL_statusvalue_vms = evalue; \
- if ((I32)PL_statusvalue_vms == -1) { \
+ if (evalue == -1) { \
PL_statusvalue = -1; \
PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \
} else \
- PL_statusvalue = Perl_vms_status_to_unix(evalue, _x); \
+ PL_statusvalue = Perl_vms_status_to_unix(evalue, 1); \
set_vaxc_errno(evalue); \
- set_errno(PL_statusvalue); \
- if (_x) PL_statusvalue = PL_statusvalue << child_offset_bits; \
+ if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX) \
+ set_errno(EVMSERR); \
+ else set_errno(Perl_vms_status_to_unix(evalue, 0)); \
+ PL_statusvalue = PL_statusvalue << child_offset_bits; \
} \
} STMT_END
@@ -2641,42 +2648,56 @@
/* 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
- * values and are only being encoded into the NATIVE form so
- * that they can be properly passed through to the calling
- * program or shell.
+ * 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;
+ *
+ * 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.
+ *
+ * If the exit code is not clearly a UNIX parent or child exit status,
+ * it will be passed through as a VMS status.
*/
-# define STATUS_UNIX_EXIT_SET(n) \
+# define STATUS_UNIX_EXIT_SET(n) \
STMT_START { \
I32 evalue = (I32)n; \
PL_statusvalue = evalue; \
- if (PL_statusvalue != -1) { \
- if (PL_statusvalue != EVMSERR) { \
- if (PL_statusvalue < 256) { \
- if (PL_statusvalue == 0) \
- PL_statusvalue_vms == SS$_NORMAL; \
- else \
- PL_statusvalue_vms = MY_POSIX_EXIT ? \
- (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
- (STS$K_ERROR | STS$M_INHIB_MSG) : 0) : evalue; \
- } else { /* forgive them Perl, for they have sinned */ \
- PL_statusvalue_vms = evalue; \
- } /* And obviously used a VMS status value instead of UNIX
*/ \
- PL_statusvalue = EVMSERR; \
- } \
- else { \
- PL_statusvalue_vms = vaxc$errno; \
- } \
+ if (evalue != -1) { \
+ if (evalue <= 0xFF00) { \
+ if (evalue > 0xFF) \
+ evalue = (evalue >> child_offset_bits) & 0xFF; \
+ if (evalue == 0) \
+ PL_statusvalue_vms == SS$_NORMAL; \
+ else \
+ 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 = SS$_ABORT; \
+ } else { /* forgive them Perl, for they have sinned */ \
+ if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \
+ else PL_statusvalue_vms = vaxc$errno; \
+ /* And obviously used a VMS status value instead of UNIX */ \
+ PL_statusvalue = EVMSERR; \
+ } \
} \
else PL_statusvalue_vms = SS$_ABORT; \
set_vaxc_errno(PL_statusvalue_vms); \
} STMT_END
+
+
+ /* This macro forces a success status */
# define STATUS_ALL_SUCCESS \
(PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL)
+
+ /* This macro forces a failure status */
# define STATUS_ALL_FAILURE (PL_statusvalue = 1, \
vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \
(C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT)
+
#else
# define STATUS_NATIVE PL_statusvalue_posix
# if defined(WCOREDUMP)
--- /rsync_root/perl/vms/vms.c Thu Oct 20 05:05:08 2005
+++ vms/vms.c Thu Oct 20 12:58:27 2005
@@ -1865,7 +1865,9 @@
case SS$_NOSUCHOBJECT:
unix_status = ENOENT;
break;
- case SS$_ABORT:
+ case SS$_ABORT: /* Fatal case */
+ case ((SS$_ABORT & STS$M_COND_ID) | STS$K_ERROR): /* Error case */
+ case ((SS$_ABORT & STS$M_COND_ID) | STS$K_WARNING): /* Warning case */
unix_status = EINTR;
break;
case SS$_BUFFEROVF:
