This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Skip failing exit(0) tests on VMS.
authorCraig A. Berry <craigberry@mac.com>
Fri, 29 Dec 2017 22:30:23 +0000 (16:30 -0600)
committerCraig A. Berry <craigberry@mac.com>
Fri, 29 Dec 2017 22:30:23 +0000 (16:30 -0600)
It turns out VMS does not have the [perl #2754] bug.  When a call
to Perl_my_exit(0) is made from one of the blocks processed during
perl_parse, STATUS_ALL_SUCCESS sets PL_statusvalue_vms to 1. This
is the value that becomes the return value of perl_parse via
STATUS_EXIT.  That return value, when non-zero, means perl_run is
skipped.  Which seems to be the desired behavior, i.e., exit(0)
from BEGIN, CHECK, and UNITCHECK does actually exit.

The fix on Unix has been rolled back in 857320cbf85e762add18885ae8
temporarily because Module::Install was depending on the bug.  It
doesn't seem worth trying to write a compatible bug for VMS, so
just skip the tests that are enforcing the buggy behavior.

t/op/blocks.t

index a4f9633..f220ab2 100644 (file)
@@ -149,13 +149,22 @@ fresh_perl_is('END { print "ok\n" } INIT { bless {} and exit }', "ok\n",
 # [perl #2754] exit(0) didn't exit from inside a UNITCHECK or CHECK block
 my $testblocks = join(" ", "BEGIN { \$| = 1; }", (map { "@{[uc($_)]} { print \"$_\\n\"; }" } qw(begin unitcheck check init end)), "print \"main\\n\";");
 fresh_perl_is($testblocks, "begin\nunitcheck\ncheck\ninit\nmain\nend", {}, 'blocks execute in right order');
-fresh_perl_is("$testblocks BEGIN { exit 0; }", "begin\nunitcheck\ncheck\ninit\nend", {}, "BEGIN{exit 0} doesn't exit yet");
+SKIP: {
+    skip "VMS doesn't have the perl #2754 bug", 1 if $^O eq 'VMS';
+    fresh_perl_is("$testblocks BEGIN { exit 0; }", "begin\nunitcheck\ncheck\ninit\nend", {}, "BEGIN{exit 0} doesn't exit yet");
+}
 fresh_perl_is("$testblocks BEGIN { exit 1; }", "begin\nunitcheck\ncheck\nend", {}, "BEGIN{exit 1} should exit");
 fresh_perl_like("$testblocks BEGIN { die; }", qr/\Abegin\nDied[^\n]*\.\nBEGIN failed[^\n]*\.\nunitcheck\ncheck\nend\z/, {}, "BEGIN{die} should exit");
-fresh_perl_is("$testblocks UNITCHECK { exit 0; }", "begin\nunitcheck\ncheck\ninit\nmain\nend", {}, "UNITCHECK{exit 0} doesn't exit yet");
+SKIP: {
+    skip "VMS doesn't have the perl #2754 bug", 1 if $^O eq 'VMS';
+    fresh_perl_is("$testblocks UNITCHECK { exit 0; }", "begin\nunitcheck\ncheck\ninit\nmain\nend", {}, "UNITCHECK{exit 0} doesn't exit yet");
+}
 fresh_perl_is("$testblocks UNITCHECK { exit 1; }", "begin\nunitcheck\ncheck\nend", {}, "UNITCHECK{exit 1} should exit");
 fresh_perl_like("$testblocks UNITCHECK { die; }", qr/\Abegin\nDied[^\n]*\.\nUNITCHECK failed[^\n]*\.\nunitcheck\ncheck\nend\z/, {}, "UNITCHECK{die} should exit");
-fresh_perl_is("$testblocks CHECK { exit 0; }", "begin\nunitcheck\ncheck\ninit\nmain\nend", {}, "CHECK{exit 0} doesn't exit yet");
+SKIP: {
+    skip "VMS doesn't have the perl #2754 bug", 1 if $^O eq 'VMS';
+    fresh_perl_is("$testblocks CHECK { exit 0; }", "begin\nunitcheck\ncheck\ninit\nmain\nend", {}, "CHECK{exit 0} doesn't exit yet");
+}
 fresh_perl_is("$testblocks CHECK { exit 1; }", "begin\nunitcheck\ncheck\nend", {}, "CHECK{exit 1} should exit");
 fresh_perl_like("$testblocks CHECK { die; }", qr/\Abegin\nunitcheck\nDied[^\n]*\.\nCHECK failed[^\n]*\.\ncheck\nend\z/, {}, "CHECK{die} should exit");