bisect-runner.pl needs to work around an OpenBSD/sparc compiler bug.

[perl5.git] / win32 / perlhost.h

diff --git a/win32/perlhost.h b/win32/perlhost.h
index 3bd3e16..e8f5fb4 100644 (file)
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -26,9 +26,10 @@
 #endif
 
 START_EXTERN_C
-extern char *          g_win32_get_privlib(const char *pl);
-extern char *          g_win32_get_sitelib(const char *pl);
-extern char *          g_win32_get_vendorlib(const char *pl);
+extern char *          g_win32_get_privlib(const char *pl, STRLEN *const len);
+extern char *          g_win32_get_sitelib(const char *pl, STRLEN *const len);
+extern char *          g_win32_get_vendorlib(const char *pl,
+                                             STRLEN *const len);
 extern char *          g_getlogin(void);
 END_EXTERN_C
 
@@ -517,21 +518,22 @@ PerlEnvOsId(struct IPerlEnv* piPerl)
 }
 
 char*
-PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
+PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
 {
-    return g_win32_get_privlib(pl);
+    return g_win32_get_privlib(pl, len);
 }
 
 char*
-PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
+PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
 {
-    return g_win32_get_sitelib(pl);
+    return g_win32_get_sitelib(pl, len);
 }
 
 char*
-PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
+PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl,
+                    STRLEN *const len)
 {
-    return g_win32_get_vendorlib(pl);
+    return g_win32_get_vendorlib(pl, len);
 }
 
 void
@@ -661,19 +663,19 @@ PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
 }
 
 char*
-PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
+PerlStdIOGets(struct IPerlStdIO* piPerl, char* s, int n, FILE* pf)
 {
     return win32_fgets(s, n, pf);
 }
 
 int
-PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
+PerlStdIOPutc(struct IPerlStdIO* piPerl, int c, FILE* pf)
 {
     return win32_fputc(c, pf);
 }
 
 int
-PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
+PerlStdIOPuts(struct IPerlStdIO* piPerl, const char *s, FILE* pf)
 {
     return win32_fputs(s, pf);
 }
@@ -838,21 +840,6 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
     int fileno = win32_dup(win32_fileno(pf));
 
     /* open the file in the same mode */
-#ifdef __BORLANDC__
-    if((pf)->flags & _F_READ) {
-       mode[0] = 'r';
-       mode[1] = 0;
-    }
-    else if((pf)->flags & _F_WRIT) {
-       mode[0] = 'a';
-       mode[1] = 0;
-    }
-    else if((pf)->flags & _F_RDWR) {
-       mode[0] = 'r';
-       mode[1] = '+';
-       mode[2] = 0;
-    }
-#else
     if((pf)->_flag & _IOREAD) {
        mode[0] = 'r';
        mode[1] = 0;
@@ -866,7 +853,6 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
        mode[1] = '+';
        mode[2] = 0;
     }
-#endif
 
     /* it appears that the binmode is attached to the
      * file descriptor so binmode files will be handled
@@ -1002,7 +988,7 @@ PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
 int
 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
 {
-    return isatty(fd);
+    return win32_isatty(fd);
 }
 
 int
@@ -1708,7 +1694,6 @@ static THREAD_RET_TYPE
 win32_start_child(LPVOID arg)
 {
     PerlInterpreter *my_perl = (PerlInterpreter*)arg;
-    GV *tmpgv;
     int status;
     HWND parent_message_hwnd;
 #ifdef PERL_SYNC_FORK
@@ -1720,23 +1705,11 @@ win32_start_child(LPVOID arg)
     PERL_SET_THX(my_perl);
     win32_checkTLS(my_perl);
 
-    /* set $$ to pseudo id */
 #ifdef PERL_SYNC_FORK
     w32_pseudo_id = id;
 #else
     w32_pseudo_id = GetCurrentThreadId();
-    if (IsWin95()) {
-       int pid = (int)w32_pseudo_id;
-       if (pid < 0)
-           w32_pseudo_id = -pid;
-    }
 #endif
-    if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
-       SV *sv = GvSV(tmpgv);
-       SvREADONLY_off(sv);
-       sv_setiv(sv, -(IV)w32_pseudo_id);
-       SvREADONLY_on(sv);
-    }
 #ifdef PERL_USES_PL_PIDSTATUS    
     hv_clear(PL_pidstatus);
 #endif    
@@ -1745,7 +1718,7 @@ win32_start_child(LPVOID arg)
     parent_message_hwnd = w32_message_hwnd;
     w32_message_hwnd = win32_create_message_window();
     if (parent_message_hwnd != NULL)
-        PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LONG)w32_message_hwnd);
+        PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LPARAM)w32_message_hwnd);
 
     /* push a zero on the stack (we are the child) */
     {
@@ -1760,13 +1733,23 @@ win32_start_child(LPVOID arg)
 
     {
        dJMPENV;
-       volatile int oldscope = PL_scopestack_ix;
+       volatile int oldscope = 1; /* We are responsible for all scopes */
 
 restart:
        JMPENV_PUSH(status);
        switch (status) {
        case 0:
            CALLRUNOPS(aTHX);
+            /* We may have additional unclosed scopes if fork() was called
+             * from within a BEGIN block.  See perlfork.pod for more details.
+             * We cannot clean up these other scopes because they belong to a
+             * different interpreter, but we also cannot leave PL_scopestack_ix
+             * dangling because that can trigger an assertion in perl_destruct().
+             */
+            if (PL_scopestack_ix > oldscope) {
+                PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
+                PL_scopestack_ix = oldscope;
+            }
            status = 0;
            break;
        case 2:
@@ -1774,6 +1757,10 @@ restart:
                LEAVE;
            FREETMPS;
            PL_curstash = PL_defstash;
+           if (PL_curstash != PL_defstash) {
+               SvREFCNT_dec(PL_curstash);
+               PL_curstash = (HV *)SvREFCNT_inc(PL_defstash);
+           }
            if (PL_endav && !PL_minus_c)
                call_list(oldscope, PL_endav);
            status = STATUS_EXIT;
@@ -1833,7 +1820,8 @@ PerlProcFork(struct IPerlProc* piPerl)
        return -1;
     }
     h = new CPerlHost(*(CPerlHost*)w32_internal_host);
-    PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
+    PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX,
+                                                CLONEf_COPY_STACKS,
                                                 h->m_pHostperlMem,
                                                 h->m_pHostperlMemShared,
                                                 h->m_pHostperlMemParse,
@@ -1867,13 +1855,9 @@ PerlProcFork(struct IPerlProc* piPerl)
        errno = EAGAIN;
        return -1;
     }
-    if (IsWin95()) {
-       int pid = (int)id;
-       if (pid < 0)
-           id = -pid;
-    }
     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
+    w32_pseudo_child_sigterm[w32_num_pseudo_children] = 0;
     ++w32_num_pseudo_children;
 #  endif
     return -(int)id;