const int status = PerlProc_pclose(IoIFP(io));
if (not_implicit) {
STATUS_NATIVE_SET(status);
- retval = (STATUS_POSIX == 0);
+ retval = (STATUS_UNIX == 0);
}
else {
retval = (status != -1);
#define PL_srand_called (vTHX->Isrand_called)
#define PL_stashcache (vTHX->Istashcache)
#define PL_statusvalue (vTHX->Istatusvalue)
+#define PL_statusvalue_posix (vTHX->Istatusvalue_posix)
#define PL_statusvalue_vms (vTHX->Istatusvalue_vms)
#define PL_stderrgv (vTHX->Istderrgv)
#define PL_stdingv (vTHX->Istdingv)
#define PL_Isrand_called PL_srand_called
#define PL_Istashcache PL_stashcache
#define PL_Istatusvalue PL_statusvalue
+#define PL_Istatusvalue_posix PL_statusvalue_posix
#define PL_Istatusvalue_vms PL_statusvalue_vms
#define PL_Istderrgv PL_stderrgv
#define PL_Istdingv PL_stdingv
if (strEQ(name2, "ERSION"))
GvMULTI_on(gv);
break;
+ case '\003': /* $^CHILD_ERROR_NATIVE */
+ if (strEQ(name2, "HILD_ERROR_NATIVE"))
+ goto magicalize;
+ break;
case '\005': /* $^ENCODING */
if (strEQ(name2, "NCODING"))
goto magicalize;
PERLVAR(Iexit_flags, U8) /* was exit() unexpected, etc. */
#ifdef VMS
PERLVAR(Istatusvalue_vms,U32)
+#else
+PERLVAR(Istatusvalue_posix,I32)
#endif
/* shortcuts to various I/O objects */
case '\001': /* ^A */
sv_setsv(sv, PL_bodytarget);
break;
- case '\003': /* ^C */
- sv_setiv(sv, (IV)PL_minus_c);
+ case '\003': /* ^C, ^CHILD_ERROR_NATIVE */
+ if (*(mg->mg_ptr+1) == '\0') {
+ sv_setiv(sv, (IV)PL_minus_c);
+ }
+ else if (strEQ(mg->mg_ptr, "\003HILD_ERROR_NATIVE")) {
+ sv_setiv(sv, (IV)STATUS_NATIVE);
+ }
break;
case '\004': /* ^D */
STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
else
#endif
- STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ STATUS_UNIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '!':
{
#else
int exitstatus;
if (errno & 255)
- STATUS_POSIX_SET(errno);
+ STATUS_UNIX_SET(errno);
else {
- exitstatus = STATUS_POSIX >> 8;
+ exitstatus = STATUS_UNIX >> 8;
if (exitstatus & 255)
- STATUS_POSIX_SET(exitstatus);
+ STATUS_UNIX_SET(exitstatus);
else
- STATUS_POSIX_SET(255);
+ STATUS_UNIX_SET(255);
}
#endif
my_exit_jump();
# include "netware.h"
#endif
+#define STATUS_UNIX PL_statusvalue
#ifdef VMS
# define STATUS_NATIVE PL_statusvalue_vms
# define STATUS_NATIVE_EXPORT \
else \
PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \
} STMT_END
-# define STATUS_POSIX PL_statusvalue
# ifdef VMSISH_STATUS
-# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX)
+# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX)
# else
-# define STATUS_CURRENT STATUS_POSIX
+# define STATUS_CURRENT STATUS_UNIX
# endif
-# define STATUS_POSIX_SET(n) \
+# define STATUS_UNIX_SET(n) \
STMT_START { \
PL_statusvalue = (n); \
if (PL_statusvalue != -1) { \
# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1)
# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44)
#else
-# define STATUS_NATIVE STATUS_POSIX
-# define STATUS_NATIVE_EXPORT STATUS_POSIX
-# define STATUS_NATIVE_SET STATUS_POSIX_SET
-# define STATUS_POSIX PL_statusvalue
-# define STATUS_POSIX_SET(n) \
+# define STATUS_NATIVE PL_statusvalue_posix
+# define STATUS_NATIVE_EXPORT STATUS_NATIVE
+# if defined(WCOREDUMP)
+# define STATUS_NATIVE_SET(n) \
+ STMT_START { \
+ PL_statusvalue_posix = (n); \
+ if (PL_statusvalue_posix == -1) \
+ PL_statusvalue = -1; \
+ else { \
+ PL_statusvalue = \
+ (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \
+ (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0) | \
+ (WIFSIGNALED(PL_statusvalue_posix) && WCOREDUMP(PL_statusvalue_posix) ? 0x80 : 0); \
+ } \
+ } STMT_END
+# elif defined(WIFEXITED)
+# define STATUS_NATIVE_SET(n) \
+ STMT_START { \
+ PL_statusvalue_posix = (n); \
+ if (PL_statusvalue_posix == -1) \
+ PL_statusvalue = -1; \
+ else { \
+ PL_statusvalue = \
+ (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \
+ (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0); \
+ } \
+ } STMT_END
+# else
+# define STATUS_NATIVE_SET(n) \
+ STMT_START { \
+ PL_statusvalue_posix = (n); \
+ if (PL_statusvalue_posix == -1) \
+ PL_statusvalue = -1; \
+ else { \
+ PL_statusvalue = \
+ PL_statusvalue_posix & 0xFFFF; \
+ } \
+ } STMT_END
+# endif
+# define STATUS_UNIX_SET(n) \
STMT_START { \
PL_statusvalue = (n); \
+ PL_statusvalue_posix = PL_statusvalue; \
if (PL_statusvalue != -1) \
PL_statusvalue &= 0xFFFF; \
} STMT_END
-# define STATUS_CURRENT STATUS_POSIX
-# define STATUS_ALL_SUCCESS (PL_statusvalue = 0)
-# define STATUS_ALL_FAILURE (PL_statusvalue = 1)
+# define STATUS_CURRENT STATUS_UNIX
+# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0)
+# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1)
#endif
/* flags in PL_exit_flags for nature of exit() */
#define PL_stashcache (*Perl_Istashcache_ptr(aTHX))
#undef PL_statusvalue
#define PL_statusvalue (*Perl_Istatusvalue_ptr(aTHX))
+#undef PL_statusvalue_posix
+#define PL_statusvalue_posix (*Perl_Istatusvalue_posix_ptr(aTHX))
#undef PL_statusvalue_vms
#define PL_statusvalue_vms (*Perl_Istatusvalue_vms_ptr(aTHX))
#undef PL_stderrgv
program exited non-zero, C<$!> will be set to C<0>.) Closing a pipe
also waits for the process executing on the pipe to complete, in case you
want to look at the output of the pipe afterwards, and
-implicitly puts the exit status value of that command into C<$?>.
+implicitly puts the exit status value of that command into C<$?> and
+C<${^CHILD_ERROR_NATIVE}>.
Prematurely closing the read end of a pipe (i.e. before the process
writing to it at the other end has closed it) will result in a
of $^F. See L<perlvar/$^F>.
Closing any piped filehandle causes the parent process to wait for the
-child to finish, and returns the status value in C<$?>.
+child to finish, and returns the status value in C<$?> and
+C<${^CHILD_ERROR_NATIVE}>.
The filename passed to 2-argument (or 1-argument) form of open() will
have leading and trailing whitespace deleted, and the normal
printf "child exited with value %d\n", $? >> 8;
}
-or more portably by using the W*() calls of the POSIX extension;
-see L<perlport> for more information.
+Alternatively you might inspect the value of C<${^CHILD_ERROR_NATIVE}>
+with the W*() calls of the POSIX extension.
When the arguments get executed via the system shell, results
and return codes will be subject to its quirks and capabilities.
Behaves like the wait(2) system call on your system: it waits for a child
process to terminate and returns the pid of the deceased process, or
-C<-1> if there are no child processes. The status is returned in C<$?>.
+C<-1> if there are no child processes. The status is returned in C<$?>
+and C<{^CHILD_ERROR_NATIVE}.
Note that a return value of C<-1> could mean that child processes are
being automatically reaped, as described in L<perlipc>.
Waits for a particular child process to terminate and returns the pid of
the deceased process, or C<-1> if there is no such child process. On some
systems, a value of 0 indicates that there are processes still running.
-The status is returned in C<$?>. If you say
+The status is returned in C<$?> and C<{^CHILD_ERROR_NATIVE}. If you say
use POSIX ":sys_wait_h";
#...
=item system
-In general, do not assume the UNIX/POSIX semantics that you can shift
-C<$?> right by eight to get the exit value, or that C<$? & 127>
-would give you the number of the signal that terminated the program,
-or that C<$? & 128> would test true if the program was terminated by a
-coredump. Instead, use the POSIX W*() interfaces: for example, use
-WIFEXITED($?) and WEXITVALUE($?) to test for a normal exit and the exit
-value, WIFSIGNALED($?) and WTERMSIG($?) for a signal exit and the
-signal. Core dumping is not a portable concept, so there's no portable
-way to test for that.
-
Only implemented if ToolServer is installed. (S<Mac OS>)
As an optimization, may not call the command shell specified in
The status returned by the last pipe close, backtick (C<``>) command,
successful call to wait() or waitpid(), or from the system()
operator. This is just the 16-bit status word returned by the
-wait() system call (or else is made up to look like it). Thus, the
+traditional Unix wait() system call (or else is made up to look like it). Thus, the
exit value of the subprocess is really (C<<< $? >> 8 >>>), and
C<$? & 127> gives which signal, if any, the process died from, and
C<$? & 128> reports whether there was a core dump. (Mnemonic:
Also see L<Error Indicators>.
+=item ${^CHILD_ERROR_NATIVE}
+
+The native status returned by the last pipe close, backtick (C<``>)
+command, successful call to wait() or waitpid(), or from the system()
+operator. On POSIX-like systems this value can be decoded with the
+WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WIFSTOPPED, WSTOPSIG
+and WIFCONTINUED functions provided by the L<POSIX> module.
+
+Under VMS this reflects the actual VMS exit status; i.e. it is the same
+as $? when the pragma C<use vmsish 'status'> is in effect.
+
=item ${^ENCODING}
The I<object reference> to the Encode object that is used to convert
BEGIN {
# MacOS system() doesn't have good return value
- $numtests = ($^O eq 'VMS') ? 7 : ($^O eq 'MacOS') ? 0 : 3;
+ $numtests = ($^O eq 'VMS') ? 10 : ($^O eq 'MacOS') ? 0 : 17;
}
require "test.pl";
$exit = run('exit');
is( $exit >> 8, 0, 'Normal exit' );
+is( $exit, $?, 'Normal exit $?' );
+is( ${^CHILD_ERROR_NATIVE}, 0, 'Normal exit ${^CHILD_ERROR_NATIVE}' );
if ($^O ne 'VMS') {
+ my $posix_ok = eval { require POSIX; };
$exit = run('exit 42');
is( $exit >> 8, 42, 'Non-zero exit' );
+ is( $exit, $?, 'Non-zero exit $?' );
+ isnt( !${^CHILD_ERROR_NATIVE}, 0, 'Non-zero exit ${^CHILD_ERROR_NATIVE}' );
+ SKIP: {
+ skip("No POSIX", 3) unless $posix_ok;
+ ok(POSIX::WIFEXITED(${^CHILD_ERROR_NATIVE}), "WIFEXITED");
+ ok(!POSIX::WIFSIGNALED(${^CHILD_ERROR_NATIVE}), "WIFSIGNALED");
+ is(POSIX::WEXITSTATUS(${^CHILD_ERROR_NATIVE}), 42, "WEXITSTATUS");
+ }
+
+ $exit = run('kill 15, $$; sleep(1);');
+
+ is( $exit & 127, 15, 'Term by signal' );
+ ok( !($exit & 128), 'No core dump' );
+ is( $? & 127, 15, 'Term by signal $?' );
+ isnt( ${^CHILD_ERROR_NATIVE}, 0, 'Term by signal ${^CHILD_ERROR_NATIVE}' );
+ SKIP: {
+ skip("No POSIX", 3) unless $posix_ok;
+ ok(!POSIX::WIFEXITED(${^CHILD_ERROR_NATIVE}), "WIFEXITED");
+ ok(POSIX::WIFSIGNALED(${^CHILD_ERROR_NATIVE}), "WIFSIGNALED");
+ is(POSIX::WTERMSIG(${^CHILD_ERROR_NATIVE}), 15, "WTERMSIG");
+ }
} else {
# On VMS, in the child process the actual exit status will be SS$_ABORT,
# which is what you get from any non-zero value of $? that has been
-# dePOSIXified by STATUS_POSIX_SET. In the parent process, all we'll
+# dePOSIXified by STATUS_UNIX_SET. In the parent process, all we'll
# see are the severity bits (0-2) shifted left by 8.
$exit_arg = (44 & 7) if $^O eq 'VMS';
projects / p5sagit/p5-mst-13.2.git / commitdiff