The VMS posix exit mode is usable both DCL/MMS/MMK and GNV Bash/Make.
The only reason not to use it is for existing scripts that are expecting
only the limited traditional error exit codes, which is why it is not
the default.
Using Perl under GNV Bash or other programs written in C almost requires
this mode, especially if they are targeted only for Unix. But even DCL
scripts will benefit from this mode.
It can be set with either the logical name PERL_VMS_POSIX_EXIT, or by
setting the DECC$FILENAME_UNIX_REPORT logical name.
In perl.h, some parenthesis were missing, and a range check was needed.
In vms/vms.c, add a logical name to control POSIX_EXIT mode, and fix
future detection of shells on VMS.
In t/run/exit.t convert the tests to run in GNV mode.
Note: the t/run/exit.t inserts code to look for a future VMS::Feature
module that can be used to access the specific mode that PERL on VMS is
operating under. The testing of the logical names through $ENV
variables is a fallback.
In dual life modules, the fallback would also need to check the version
of Perl, as support for the VMS features is in Perl 5.10.
TODO: Fix perl on VMS to exit with C facility encoded 15 on the
reception of a SIGTERM in posix exit mode.
-John
[EMAIL PROTECTED]
Personal Opinion Only
EAGLE> show log decc$*
(LNM$JOB_822FECC0)
"DECC$EFS_CASE_PRESERVE" = "enable"
"DECC$EFS_CHARSET" = "ENABLE"
"DECC$FILENAME_UNIX_NO_VERSION" = "enable"
"DECC$FILENAME_UNIX_REPORT" = "enable"
"DECC$READDIR_DROPDOTNOTYPE" = "enable"
EAGLE> mcr []perl.exe "-I[-.lib]" ../t/run/exit.t
1..29
ok 1 - Normal exit
ok 2 - Normal exit $?
ok 3 - Normal exit ${^CHILD_ERROR_NATIVE}
ok 4 - Non-zero exit
ok 5 - Non-zero exit $?
ok 6 - Non-zero exit ${^CHILD_ERROR_NATIVE}
ok 7 # skip No POSIX wait macros
ok 8 # skip No POSIX wait macros
ok 9 # skip No POSIX wait macros
ok 10 # skip Skip signals and core dump tests on Win32 and VMS
ok 11 # skip Skip signals and core dump tests on Win32 and VMS
ok 12 # skip Skip signals and core dump tests on Win32 and VMS
ok 13 # skip Skip signals and core dump tests on Win32 and VMS
ok 14 # skip Skip signals and core dump tests on Win32 and VMS
ok 15 # skip Skip signals and core dump tests on Win32 and VMS
ok 16 # skip Skip signals and core dump tests on Win32 and VMS
ok 17 - PERL success exit
ok 18 - VMS success exit
ok 19 - PERL informational exit
ok 20 - VMS informational exit
ok 21 - Perl warning exit
ok 22 - VMS warning exit
ok 23 - Perl error exit
ok 24 - VMS error exit
ok 25 - Perl fatal error exit
ok 26 - VMS fatal exit
ok 27 - Posix exit code 1
ok 28 - Posix exit code 255
ok 29 - Changing $? in END block
--- /rsync_root/perl/perl.h Sat Nov 8 06:42:25 2008
+++ perl.h Sat Nov 8 15:47:18 2008
@@ -2941,9 +2941,9 @@
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) : 1); \
+ PL_statusvalue_vms = \
+ (C_FAC_POSIX | (evalue << 3 ) | \
+ ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \
else \
PL_statusvalue_vms = SS$_ABORT; \
} else { /* forgive them Perl, for they have sinned */ \
@@ -2969,6 +2969,9 @@
* actual exit code will can be retrieved by the calling program or
* shell.
*
+ * A POSIX exit code is from 0 to 255. If the exit code is higher
+ * than this, it needs to be assumed that it is a VMS exit code and
+ * passed through.
*/
# define STATUS_EXIT_SET(n) \
@@ -2976,9 +2979,10 @@
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) : 1); \
+ if (evalue > 255) PL_statusvalue_vms = evalue; else { \
+ PL_statusvalue_vms = \
+ (C_FAC_POSIX | (evalue << 3 ) | \
+ ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \
else \
PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \
set_vaxc_errno(PL_statusvalue_vms); \
--- /rsync_root/perl/vms/vms.c Sun Nov 2 15:17:29 2008
+++ vms/vms.c Sat Nov 8 23:53:49 2008
@@ -353,6 +353,7 @@
int vms_vtf7_filenames = 0;
int gnv_unix_shell = 0;
static int vms_unlink_all_versions = 0;
+static int vms_posix_exit = 0;
/* bug workarounds if needed */
int decc_bug_readdir_efs1 = 0;
@@ -13080,9 +13081,7 @@
VMSISH_HUSHED = 0;
- /* fix me later to track running under GNV */
- /* this allows some limited testing */
- MY_POSIX_EXIT = decc_filename_unix_report;
+ MY_POSIX_EXIT = vms_posix_exit;
x = (float)ix;
MY_INV_RAND_MAX = 1./x;
@@ -13556,7 +13555,6 @@
gnv_unix_shell = 0;
status = sys_trnlnm("GNV$UNIX_SHELL", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
- if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
gnv_unix_shell = 1;
set_feature_default("DECC$EFS_CASE_PRESERVE", 1);
set_feature_default("DECC$EFS_CHARSET", 1);
@@ -13565,9 +13563,7 @@
set_feature_default("DECC$READDIR_DROPDOTNOTYPE", 1);
set_feature_default("DECC$DISABLE_POSIX_ROOT", 0);
vms_unlink_all_versions = 1;
- }
- else
- gnv_unix_shell = 0;
+ vms_posix_exit = 1;
}
#endif
@@ -13638,8 +13634,10 @@
s = decc$feature_get_index("DECC$FILENAME_UNIX_REPORT");
if (s >= 0) {
decc_filename_unix_report = decc$feature_get_value(s, 1);
- if (decc_filename_unix_report > 0)
+ if (decc_filename_unix_report > 0) {
decc_filename_unix_report = 1;
+ vms_posix_exit = 1;
+ }
else
decc_filename_unix_report = 0;
}
@@ -13766,6 +13764,17 @@
vms_process_case_tolerant = 0;
#endif
+
+ /* USE POSIX/DCL Exit codes - Recommended, but needs to default to */
+ /* for strict backward compatibilty */
+ status = sys_trnlnm
+ ("PERL_VMS_POSIX_EXIT", val_str, sizeof(val_str));
+ if ($VMS_STATUS_SUCCESS(status)) {
+ if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
+ vms_posix_exit = 1;
+ else
+ vms_posix_exit = 0;
+ }
/* CRTL can be initialized past this point, but not before. */
--- /rsync_root/perl/t/run/exit.t Sun Jun 1 12:33:42 2008
+++ t/run/exit.t Sun Nov 9 00:01:20 2008
@@ -20,6 +20,24 @@
$numtests = ($^O eq 'VMS') ? 16 : ($^O eq 'MacOS') ? 0 : 17;
}
+
+my $vms_exit_mode = 0;
+
+if ($^O eq 'VMS') {
+ if (eval 'require VMS::Feature') {
+ $vms_exit_mode = !(VMS::Feature::current("posix_exit"));
+ } else {
+ my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} =~ /^[ET1]/i;
+ my $posix_ex = $ENV{'PERL_VMS_POSIX_EXIT'} =~ /^[ET1]/i;
+ if (($unix_rpt || $posix_ex) ) {
+ $vms_exit_mode = 0;
+ } else {
+ $vms_exit_mode = 1;
+ }
+ }
+ $numtests = 29 unless $vms_exit_mode;
+}
+
require "test.pl";
plan(tests => $numtests);
@@ -34,7 +52,7 @@
is( $exit, $?, 'Normal exit $?' );
is( ${^CHILD_ERROR_NATIVE}, $native_success, 'Normal exit
${^CHILD_ERROR_NATIVE}' );
-if ($^O ne 'VMS') {
+if (!$vms_exit_mode) {
my $posix_ok = eval { require POSIX; };
my $wait_macros_ok = defined &POSIX::WIFEXITED;
eval { POSIX::WIFEXITED() };
@@ -52,7 +70,11 @@
}
SKIP: {
- skip("Skip signals and core dump tests on Win32", 7) if $^O eq 'MSWin32';
+ skip("Skip signals and core dump tests on Win32 and VMS", 7)
+ if ($^O eq 'MSWin32' || $^O eq 'VMS');
+
+ #TODO VMS will backtrace on this test and exits with code of 0
+ #instead of 15.
$exit = run('kill 15, $$; sleep(1);');
@@ -69,7 +91,9 @@
}
}
-} else {
+}
+
+if ($^O eq 'VMS') {
# On VMS, successful returns from system() are reported 0, VMS errors that
# can not be translated to UNIX are reported as EVMSERR, which has a value
@@ -139,7 +163,7 @@
# status codes to SS$_ABORT on exit, but passes through unmodified UNIX
# status codes that exit() is called with by scripts.
-$exit_arg = (44 & 7) if $^O eq 'VMS';
+$exit_arg = (44 & 7) if $vms_exit_mode;
is( $exit >> 8, $exit_arg, 'Changing $? in END block' );
}
