This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
postpone perl_parse() exit(0) bugfix
authorZefram <zefram@fysh.org>
Wed, 27 Dec 2017 21:13:59 +0000 (21:13 +0000)
committerZefram <zefram@fysh.org>
Wed, 27 Dec 2017 21:13:59 +0000 (21:13 +0000)
Commit 0301e899536a22752f40481d8a1d141b7a7dda82 fixed a long-standing
bug regarding exit(0) during perl_parse().  This turned out to cause
enough trouble to Module::Install, which accidentally relies on the
bug, that the pumpking wants more time to roll out the fix to affected
CPAN distros.  So make perl_parse() once again return 0 for an exit(0).
Reintroduces [perl #2754]; addresses [perl #132577].

perl.c
pod/perldelta.pod
t/op/blocks.t

diff --git a/perl.c b/perl.c
index e760813..0b3ffcf 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1638,13 +1638,16 @@ For historical reasons, the non-zero return value also attempts to
 be a suitable value to pass to the C library function C<exit> (or to
 return from C<main>), to serve as an exit code indicating the nature
 of the way initialisation terminated.  However, this isn't portable,
-due to differing exit code conventions.  An attempt is made to return
-an exit code of the type required by the host operating system, but
-because it is constrained to be non-zero, it is not necessarily possible
-to indicate every type of exit.  It is only reliable on Unix, where a
-zero exit code can be augmented with a set bit that will be ignored.
-In any case, this function is not the correct place to acquire an exit
-code: one should get that from L</perl_destruct>.
+due to differing exit code conventions.  A historical bug is preserved
+for the time being: if the Perl built-in C<exit> is called during this
+function's execution, with a type of exit entailing a zero exit code
+under the host operating system's conventions, then this function
+returns zero rather than a non-zero value.  This bug, [perl #2754],
+leads to C<perl_run> being called (and therefore C<INIT> blocks and the
+main program running) despite a call to C<exit>.  It has been preserved
+because a popular module-installing module has come to rely on it and
+needs time to be fixed.  This issue is [perl #132577], and the original
+bug is due to be fixed in Perl 5.30.
 
 =cut
 */
@@ -1853,7 +1856,15 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
            call_list(oldscope, PL_checkav);
        }
        ret = STATUS_EXIT;
-       if (ret == 0) ret = 0x100;
+       if (ret == 0) {
+           /*
+            * At this point we should do
+            *     ret = 0x100;
+            * to avoid [perl #2754], but that bugfix has been postponed
+            * because of the Module::Install breakage it causes
+            * [perl #132577].
+            */
+       }
        break;
     case 3:
        PerlIO_printf(Perl_error_log, "panic: top_env\n");
index 9459525..1a90b33 100644 (file)
@@ -406,6 +406,15 @@ platform specific bugs also go here.
 
 XXX
 
+=item *
+
+The bugfix for [perl #2754] in Perl 5.27.7 turned out to cause so much
+trouble on CPAN [perl #132577] that it is being postponed.  The bug has
+been restored, so C<exit(0)> in a C<UNITCHECK> or C<CHECK> block now
+once again permits the main program to run, and C<exit(0)> in a C<BEGIN>
+block once again permits C<INIT> blocks to run before exiting.  The bug
+will be fixed again for Perl 5.30.
+
 =back
 
 =head1 Errata From Previous Releases
index f1e1a27..a4f9633 100644 (file)
@@ -149,13 +149,13 @@ 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\nend", {}, "BEGIN{exit 0} should exit");
+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\nend", {}, "UNITCHECK{exit 0} should exit");
+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\nend", {}, "CHECK{exit 0} should exit");
+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");