properly define perl_parse() return value

Zefram · Zefram · commit 0301e899536a · 2017-12-10T21:59:42.000Z
perl_parse()'s return value has historically had conflicting purposes. perlmain.c uses it as a truth value, but perlembed.pod has shown it being used as an exit code. perl_parse() has not had its own documentation. What the function has actually done is to return zero for normal completion and an exit code for early termination. For this to be a usable convention depended on early termination never using exit code 0, and that's specifically *native* exit code 0, which could have any significance. In fact exit code 0 could arise for a compile-time termination even on Unix through "CHECK { exit 0 }", and the mishandling of that situation was bug [perl #2754]. Since perl_destruct() provides a native exit code unencumbered by any attempt to simultaneously be a truth value, perl_parse() doesn't really need to provide an exit code. So define that perl_parse()'s return value is principally a truth value. Change the perlembed tutorial to show it being so used, with an exit code coming from perl_destruct(). However, most of the historical usage of perl_parse()'s return value as an exit code can be preserved. Make it return 0x100 for exit(0), which both serves as the essential truth value and on Unix also serves as the proper exit code, because that set bit will be masked off when actually exiting. This works on Unix but will have variable effect on other OSes; at least it will reliably indicate an actual exit. perl_run() has a similar problem in the interpretation of its return value, but not affecting the main perl executable, because perlmain.c ignores its return value. Similarly define that it is principally a truth value, with preserved usage of non-zero return values as exit codes, with exit code 0 transformed into 0x100. This requires some extra logic to distinguish between local completion and exit(0), which were not previously distinguished. Fully document perl_parse(), perl_run(), and perl_destruct() as API functions. Make the perlembed tutorial always show a proper exit from main(), using "exit(EXIT_SUCCESS)" for portability when errors are not being checked. Make perlembed always show a null argv[argc] being supplied to perl_parse(), where an argv is constructed. (Commit 54c85bb added a note to perlembed saying that that's required, but didn't fix the examples to show it being done.)
diff --git a/perl.c b/perl.c
@@ -593,9 +593,33 @@ Perl_dump_sv_child(pTHX_ SV *sv)
 #endif
 
 /*
-=for apidoc perl_destruct
-
-Shuts down a Perl interpreter.  See L<perlembed>.
+=for apidoc Am|int|perl_destruct|PerlInterpreter *my_perl
+
+Shuts down a Perl interpreter.  See L<perlembed> for a tutorial.
+
+C<my_perl> points to the Perl interpreter.  It must have been previously
+created through the use of L</perl_alloc> and L</perl_construct>.  It may
+have been initialised through L</perl_parse>, and may have been used
+through L</perl_run> and other means.  This function should be called for
+any Perl interpreter that has been constructed with L</perl_construct>,
+even if subsequent operations on it failed, for example if L</perl_parse>
+returned a non-zero value.
+
+If the interpreter's C<PL_exit_flags> word has the
+C<PERL_EXIT_DESTRUCT_END> flag set, then this function will execute code
+in C<END> blocks before performing the rest of destruction.  If it is
+desired to make any use of the interpreter between L</perl_parse> and
+L</perl_destruct> other than just calling L</perl_run>, then this flag
+should be set early on.  This matters if L</perl_run> will not be called,
+or if anything else will be done in addition to calling L</perl_run>.
+
+Returns a value 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 the interpreter terminated.  This takes into account
+any failure of L</perl_parse> and any early exit from L</perl_run>.
+The exit code is of the type required by the host operating system,
+so because of differing exit code conventions it is not portable to
+interpret specific numeric values as having specific meanings.
 
 =cut
 */
@@ -1570,9 +1594,62 @@ Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
 }
 
 /*
-=for apidoc perl_parse
-
-Tells a Perl interpreter to parse a Perl script.  See L<perlembed>.
+=for apidoc Am|int|perl_parse|PerlInterpreter *my_perl|XSINIT_t xsinit|int argc|char **argv|char **env
+
+Tells a Perl interpreter to parse a Perl script.  This performs most
+of the initialisation of a Perl interpreter.  See L<perlembed> for
+a tutorial.
+
+C<my_perl> points to the Perl interpreter that is to parse the script.
+It must have been previously created through the use of L</perl_alloc>
+and L</perl_construct>.  C<xsinit> points to a callback function that
+will be called to set up the ability for this Perl interpreter to load
+XS extensions, or may be null to perform no such setup.
+
+C<argc> and C<argv> supply a set of command-line arguments to the Perl
+interpreter, as would normally be passed to the C<main> function of
+a C program.  C<argv[argc]> must be null.  These arguments are where
+the script to parse is specified, either by naming a script file or by
+providing a script in a C<-e> option.
+
+C<env> specifies a set of environment variables that will be used by
+this Perl interpreter.  If non-null, it must point to a null-terminated
+array of environment strings.  If null, the Perl interpreter will use
+the environment supplied by the C<environ> global variable.
+
+This function initialises the interpreter, and parses and compiles the
+script specified by the command-line arguments.  This includes executing
+code in C<BEGIN>, C<UNITCHECK>, and C<CHECK> blocks.  It does not execute
+C<INIT> blocks or the main program.
+
+Returns an integer of slightly tricky interpretation.  The correct
+use of the return value is as a truth value indicating whether there
+was a failure in initialisation.  If zero is returned, this indicates
+that initialisation was successful, and it is safe to proceed to call
+L</perl_run> and make other use of it.  If a non-zero value is returned,
+this indicates some problem that means the interpreter wants to terminate.
+The interpreter should not be just abandoned upon such failure; the caller
+should proceed to shut the interpreter down cleanly with L</perl_destruct>
+and free it with L</perl_free>.
+
+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>.
+
+In most cases, if something happens during initialisation and parsing
+that causes the Perl interpreter to want to exit, this will cause this
+function to return normally with a non-zero return value.  Historically,
+a call to the Perl built-in function C<exit> from inside a C<BEGIN>
+block has been an exception, causing the process to actually exit.
+That behaviour may change in the future.
 
 =cut
 */
@@ -1774,6 +1851,7 @@ 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;
 	break;
     case 3:
 	PerlIO_printf(Perl_error_log, "panic: top_env\n");
@@ -2483,9 +2561,47 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 }
 
 /*
-=for apidoc perl_run
-
-Tells a Perl interpreter to run.  See L<perlembed>.
+=for apidoc Am|int|perl_run|PerlInterpreter *my_perl
+
+Tells a Perl interpreter to run its main program.  See L<perlembed>
+for a tutorial.
+
+C<my_perl> points to the Perl interpreter.  It must have been previously
+created through the use of L</perl_alloc> and L</perl_construct>, and
+initialised through L</perl_parse>.  This function should not be called
+if L</perl_parse> returned a non-zero value, indicating a failure in
+initialisation or compilation.
+
+This function executes code in C<INIT> blocks, and then executes the
+main program.  The code to be executed is that established by the prior
+call to L</perl_parse>.  If the interpreter's C<PL_exit_flags> word
+does not have the C<PERL_EXIT_DESTRUCT_END> flag set, then this function
+will also execute code in C<END> blocks.  If it is desired to make any
+further use of the interpreter after calling this function, then C<END>
+blocks should be postponed to L</perl_destruct> time by setting that flag.
+
+Returns an integer of slightly tricky interpretation.  The correct use
+of the return value is as a truth value indicating whether the program
+terminated non-locally.  If zero is returned, this indicates that
+the program ran to completion, and it is safe to make other use of the
+interpreter (provided that the C<PERL_EXIT_DESTRUCT_END> flag was set as
+described above).  If a non-zero value is returned, this indicates that
+the interpreter wants to terminate early.  The interpreter should not be
+just abandoned because of this desire to terminate; the caller should
+proceed to shut the interpreter down cleanly with L</perl_destruct>
+and free it with L</perl_free>.
+
+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 the program 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>.
 
 =cut
 */
@@ -2494,7 +2610,7 @@ int
 perl_run(pTHXx)
 {
     I32 oldscope;
-    int ret = 0;
+    int ret = 0, exit_called = 0;
     dJMPENV;
 
     PERL_ARGS_ASSERT_PERL_RUN;
@@ -2515,8 +2631,10 @@ perl_run(pTHXx)
     case 0:				/* normal completion */
  redo_body:
 	run_body(oldscope);
-	/* FALLTHROUGH */
+	goto handle_exit;
     case 2:				/* my_exit() */
+	exit_called = 1;
+    handle_exit:
 	while (PL_scopestack_ix > oldscope)
 	    LEAVE;
 	FREETMPS;
@@ -2530,7 +2648,12 @@ perl_run(pTHXx)
 	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
 	    dump_mstats("after execution:  ");
 #endif
-	ret = STATUS_EXIT;
+	if (exit_called) {
+	    ret = STATUS_EXIT;
+	    if (ret == 0) ret = 0x100;
+	} else {
+	    ret = 0;
+	}
 	break;
     case 3:
 	if (PL_restartop) {
diff --git a/pod/perlembed.pod b/pod/perlembed.pod
@@ -192,6 +192,7 @@ version of I<miniperlmain.c> containing the essentials of embedding:
         perl_destruct(my_perl);
         perl_free(my_perl);
 	PERL_SYS_TERM();
+	exit(EXIT_SUCCESS);
  }
 
 Notice that we don't use the C<env> pointer.  Normally handed to
@@ -267,6 +268,7 @@ That's shown below, in a program I'll call I<showtime.c>.
         perl_destruct(my_perl);
         perl_free(my_perl);
 	PERL_SYS_TERM();
+	exit(EXIT_SUCCESS);
     }
 
 where I<showtime> is a Perl subroutine that takes no arguments (that's the
@@ -325,7 +327,7 @@ the first, a C<float> from the second, and a C<char *> from the third.
 
  main (int argc, char **argv, char **env)
  {
-     char *embedding[] = { "", "-e", "0" };
+     char *embedding[] = { "", "-e", "0", NULL };
 
      PERL_SYS_INIT3(&argc,&argv,&env);
      my_perl = perl_alloc();
@@ -504,7 +506,7 @@ been wrapped here):
 
  main (int argc, char **argv, char **env)
  {
-     char *embedding[] = { "", "-e", "0" };
+     char *embedding[] = { "", "-e", "0", NULL };
      AV *match_list;
      I32 num_matches, i;
      SV *text;
@@ -645,7 +647,7 @@ deep breath...
 
  int main (int argc, char **argv, char **env)
  {
-   char *my_argv[] = { "", "power.pl" };
+   char *my_argv[] = { "", "power.pl", NULL };
 
    PERL_SYS_INIT3(&argc,&argv,&env);
    my_perl = perl_alloc();
@@ -660,6 +662,7 @@ deep breath...
    perl_destruct(my_perl);
    perl_free(my_perl);
    PERL_SYS_TERM();
+   exit(EXIT_SUCCESS);
  }
 
 
@@ -794,25 +797,25 @@ with L<perlfunc/my> whenever possible.
  int
  main(int argc, char **argv, char **env)
  {
-     char *embedding[] = { "", "persistent.pl" };
+     char *embedding[] = { "", "persistent.pl", NULL };
      char *args[] = { "", DO_CLEAN, NULL };
      char filename[BUFFER_SIZE];
-     int exitstatus = 0;
+     int failing, exitstatus;
 
      PERL_SYS_INIT3(&argc,&argv,&env);
      if((my_perl = perl_alloc()) == NULL) {
         fprintf(stderr, "no memory!");
-        exit(1);
+        exit(EXIT_FAILURE);
      }
      perl_construct(my_perl);
 
      PL_origalen = 1; /* don't let $0 assignment update the
                          proctitle or embedding[0] */
-     exitstatus = perl_parse(my_perl, NULL, 2, embedding, NULL);
+     failing = perl_parse(my_perl, NULL, 2, embedding, NULL);
      PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
-     if(!exitstatus) {
-        exitstatus = perl_run(my_perl);
-
+     if(!failing)
+	failing = perl_run(my_perl);
+     if(!failing) {
         while(printf("Enter file name: ") &&
               fgets(filename, BUFFER_SIZE, stdin)) {
 
@@ -830,7 +833,7 @@ with L<perlfunc/my> whenever possible.
      }
 
      PL_perl_destruct_level = 0;
-     perl_destruct(my_perl);
+     exitstatus = perl_destruct(my_perl);
      perl_free(my_perl);
      PERL_SYS_TERM();
      exit(exitstatus);
@@ -951,8 +954,8 @@ Let's give it a try:
  int main(int argc, char **argv, char **env)
  {
      PerlInterpreter *one_perl, *two_perl;
-     char *one_args[] = { "one_perl", SAY_HELLO };
-     char *two_args[] = { "two_perl", SAY_HELLO };
+     char *one_args[] = { "one_perl", SAY_HELLO, NULL };
+     char *two_args[] = { "two_perl", SAY_HELLO, NULL };
 
      PERL_SYS_INIT3(&argc,&argv,&env);
      one_perl = perl_alloc();
@@ -983,6 +986,7 @@ Let's give it a try:
      PERL_SET_CONTEXT(two_perl);
      perl_free(two_perl);
      PERL_SYS_TERM();
+     exit(EXIT_SUCCESS);
  }
 
 Note the calls to PERL_SET_CONTEXT().  These are necessary to initialize
diff --git a/t/op/blocks.t b/t/op/blocks.t
@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan tests => 11;
+plan tests => 18;
 
 my @expect = qw(
 b1
@@ -146,11 +146,16 @@ expEct
 fresh_perl_is('END { print "ok\n" } INIT { bless {} and exit }', "ok\n",
 	       {}, 'null PL_curcop in newGP');
 
-fresh_perl_is('BEGIN{exit 0}; print "still here"', '', {}, 'RT #2754: BEGIN{exit 0} should exit');
-TODO: {
-    local $TODO = 'RT #2754: CHECK{exit 0} is broken';
-    fresh_perl_is('CHECK{exit 0}; print "still here"', '', {}, 'RT #2754: CHECK{exit 0} should exit');
-}
+# [perl #2754] exit(0) didn't exit from inside a UNITCHECK or CHECK block
+fresh_perl_is('BEGIN{exit 0}; print "still here"', '', {}, 'BEGIN{exit 0} should exit');
+fresh_perl_is('BEGIN{exit 1}; print "still here"', '', {}, 'BEGIN{exit 1} should exit');
+fresh_perl_like('BEGIN{die}; print "still here"', qr/\ADied[^\n]*\.\nBEGIN failed[^\n]*\.\z/, {}, 'BEGIN{die} should exit');
+fresh_perl_is('UNITCHECK{exit 0}; print "still here"', '', {}, 'UNITCHECK{exit 0} should exit');
+fresh_perl_is('UNITCHECK{exit 1}; print "still here"', '', {}, 'UNITCHECK{exit 1} should exit');
+fresh_perl_like('UNITCHECK{die}; print "still here"', qr/\ADied[^\n]*\.\nUNITCHECK failed[^\n]*\.\z/, {}, 'UNITCHECK{die} should exit');
+fresh_perl_is('CHECK{exit 0}; print "still here"', '', {}, 'CHECK{exit 0} should exit');
+fresh_perl_is('CHECK{exit 1}; print "still here"', '', {}, 'CHECK{exit 1} should exit');
+fresh_perl_like('CHECK{die}; print "still here"', qr/\ADied[^\n]*\.\nCHECK failed[^\n]*\.\z/, {}, 'CHECK{die} should exit');
 
 TODO: {
     local $TODO = 'RT #2917: INIT{} in eval is wrongly considered too late';
