Re: $^CHILD_ERROR_NATIVE issues (with attachment)

Message-ID: <lrd5ml7i8s.fsf@caliper.activestate.com>

p4raw-id: //depot/perl@25688

diff --git a/cop.h b/cop.h
index c874872..f1a51fd 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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) {