#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
}
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
int
PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
{
- return isatty(fd);
+ return win32_isatty(fd);
}
int
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) */
{
{
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:
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,