[patch@34779] Get posix exit mode working/tested on VMS
[email protected] ("John E. Malmberg")
| Newsgroups | perl.perl5.porters,perl.vmsperl |
|---|---|
| Message-ID | <[email protected]> |
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
vms_posix_exit.patch
(text/plain, 5.4 KB)
--- /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' );
}