From: Gisle Aas Date: Tue, 4 Oct 2005 02:18:27 +0000 (-0700) Subject: Re: $^CHILD_ERROR_NATIVE issues (with attachment) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=37038d913ecbccf83ca988aedaa1e6067b127dbc;p=p5sagit%2Fp5-mst-13.2.git Re: $^CHILD_ERROR_NATIVE issues (with attachment) Message-ID: p4raw-id: //depot/perl@25688 --- diff --git a/cop.h b/cop.h index c874872..f1a51fd 100644 --- a/cop.h +++ b/cop.h @@ -123,7 +123,7 @@ typedef struct jmpenv JMPENV; if (PL_top_env->je_prev) \ PerlProc_longjmp(PL_top_env->je_buf, (v)); \ if ((v) == 2) \ - PerlProc_exit(STATUS_NATIVE_EXPORT); \ + PerlProc_exit(STATUS_EXIT); \ PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \ PerlProc_exit(1); \ } STMT_END diff --git a/doio.c b/doio.c index 26554cf..640dfaf 100644 --- a/doio.c +++ b/doio.c @@ -1043,7 +1043,7 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit) if (IoTYPE(io) == IoTYPE_PIPE) { const int status = PerlProc_pclose(IoIFP(io)); if (not_implicit) { - STATUS_NATIVE_SET(status); + STATUS_NATIVE_CHILD_SET(status); retval = (STATUS_UNIX == 0); } else { diff --git a/perl.c b/perl.c index caa58d3..3cb25ea 100644 --- a/perl.c +++ b/perl.c @@ -546,7 +546,7 @@ perl_destruct(pTHXx) if (CALL_FPTR(PL_threadhook)(aTHX)) { /* Threads hook has vetoed further cleanup */ - return STATUS_NATIVE_EXPORT; + return STATUS_EXIT; } #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP @@ -768,7 +768,7 @@ perl_destruct(pTHXx) #endif /* The exit() function will do everything that needs doing. */ - return STATUS_NATIVE_EXPORT; + return STATUS_EXIT; } /* jettison our possibly duplicated environment */ @@ -1259,7 +1259,7 @@ perl_destruct(pTHXx) Safefree(PL_mess_sv); PL_mess_sv = Nullsv; } - return STATUS_NATIVE_EXPORT; + return STATUS_EXIT; } /* @@ -1555,7 +1555,7 @@ setuid perl scripts securely.\n"); PL_curstash = PL_defstash; if (PL_checkav) call_list(oldscope, PL_checkav); - ret = STATUS_NATIVE_EXPORT; + ret = STATUS_EXIT; break; case 3: PerlIO_printf(Perl_error_log, "panic: top_env\n"); @@ -2215,7 +2215,7 @@ perl_run(pTHXx) if (PerlEnv_getenv("PERL_DEBUG_MSTATS")) dump_mstats("after execution: "); #endif - ret = STATUS_NATIVE_EXPORT; + ret = STATUS_EXIT; break; case 3: if (PL_restartop) { @@ -5140,7 +5140,7 @@ Perl_my_exit(pTHX_ U32 status) STATUS_ALL_FAILURE; break; default: - STATUS_NATIVE_SET(status); + STATUS_UNIX_SET(status); break; } my_exit_jump(); diff --git a/perl.h b/perl.h index efdf7ed..148ce61 100644 --- a/perl.h +++ b/perl.h @@ -2545,7 +2545,7 @@ typedef pthread_key_t perl_key; #define STATUS_UNIX PL_statusvalue #ifdef VMS # define STATUS_NATIVE PL_statusvalue_vms -# define STATUS_NATIVE_EXPORT \ +# define STATUS_EXIT \ (((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) | (VMSISH_HUSHED ? 0x10000000 : 0)) # define STATUS_NATIVE_SET(n) STATUS_NATIVE_SET_PORC(n, 0) # define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET_PORC(n, 1) @@ -2590,10 +2590,8 @@ typedef pthread_key_t perl_key; # define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44) #else # define STATUS_NATIVE PL_statusvalue_posix -# define STATUS_NATIVE_EXPORT STATUS_NATIVE # if defined(WCOREDUMP) -# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n) -# define STATUS_NATIVE_SET(n) \ +# define STATUS_NATIVE_CHILD_SET(n) \ STMT_START { \ PL_statusvalue_posix = (n); \ if (PL_statusvalue_posix == -1) \ @@ -2606,8 +2604,7 @@ typedef pthread_key_t perl_key; } \ } STMT_END # elif defined(WIFEXITED) -# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n) -# define STATUS_NATIVE_SET(n) \ +# define STATUS_NATIVE_CHILD_SET(n) \ STMT_START { \ PL_statusvalue_posix = (n); \ if (PL_statusvalue_posix == -1) \ @@ -2619,8 +2616,7 @@ typedef pthread_key_t perl_key; } \ } STMT_END # else -# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n) -# define STATUS_NATIVE_SET(n) \ +# define STATUS_NATIVE_CHILD_SET(n) \ STMT_START { \ PL_statusvalue_posix = (n); \ if (PL_statusvalue_posix == -1) \ @@ -2634,11 +2630,11 @@ typedef pthread_key_t perl_key; # 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_UNIX +# define STATUS_EXIT 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 diff --git a/pp_sys.c b/pp_sys.c index 363c93b..2366490 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -382,7 +382,7 @@ PP(pp_backtick) TAINT; /* "I believe that this is not gratuitous!" */ } else { - STATUS_NATIVE_SET(-1); + STATUS_NATIVE_CHILD_SET(-1); if (gimme == G_SCALAR) RETPUSHUNDEF; } @@ -4247,7 +4247,7 @@ PP(pp_system) (void)rsignal_restore(SIGINT, &ihand); (void)rsignal_restore(SIGQUIT, &qhand); #endif - STATUS_NATIVE_SET(result == -1 ? -1 : status); + STATUS_NATIVE_CHILD_SET(result == -1 ? -1 : status); do_execfree(); /* free any memory child malloced on fork */ SP = ORIGMARK; if (did_pipes) { @@ -4267,7 +4267,7 @@ PP(pp_system) if (n != sizeof(int)) DIE(aTHX_ "panic: kid popen errno read"); errno = errkid; /* Propagate errno from kid */ - STATUS_CURRENT = -1; + STATUS_NATIVE_CHILD_SET(-1); } } PUSHi(STATUS_CURRENT); @@ -4869,7 +4869,7 @@ PP(pp_ghostent) h_errno = PL_reentrant_buffer->_gethostent_errno; # endif #endif - STATUS_NATIVE_SET(h_errno); + STATUS_UNIX_SET(h_errno); } #endif @@ -4980,7 +4980,7 @@ PP(pp_gnetent) h_errno = PL_reentrant_buffer->_getnetent_errno; # endif #endif - STATUS_NATIVE_SET(h_errno); + STATUS_UNIX_SET(h_errno); } #endif diff --git a/win32/perlhost.h b/win32/perlhost.h index fcc3e0a..dd63c76 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -1750,7 +1750,7 @@ restart: PL_curstash = PL_defstash; if (PL_endav && !PL_minus_c) call_list(oldscope, PL_endav); - status = STATUS_NATIVE_EXPORT; + status = STATUS_EXIT; break; case 3: if (PL_restartop) { diff --git a/wince/perlhost.h b/wince/perlhost.h index 2359464..dae5a86 100644 --- a/wince/perlhost.h +++ b/wince/perlhost.h @@ -1758,7 +1758,7 @@ restart: PL_curstash = PL_defstash; if (PL_endav && !PL_minus_c) call_list(oldscope, PL_endav); - status = STATUS_NATIVE_EXPORT; + status = STATUS_EXIT; break; case 3: if (PL_restartop) {