PL_sys_intern was being initialized too late on windows

p4raw-id: //depot/perl@6104

diff --git a/embed.h b/embed.h
index d372b20..b19115f 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -830,6 +830,9 @@
 #define ptr_table_store                Perl_ptr_table_store
 #define ptr_table_split                Perl_ptr_table_split
 #endif
+#if defined(HAVE_INTERP_INTERN)
+#define sys_intern_init                Perl_sys_intern_init
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif
@@ -2266,6 +2269,9 @@
 #define ptr_table_store(a,b,c) Perl_ptr_table_store(aTHX_ a,b,c)
 #define ptr_table_split(a)     Perl_ptr_table_split(aTHX_ a)
 #endif
+#if defined(HAVE_INTERP_INTERN)
+#define sys_intern_init()      Perl_sys_intern_init(aTHX)
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif
@@ -4441,6 +4447,10 @@
 #define Perl_ptr_table_split   CPerlObj::Perl_ptr_table_split
 #define ptr_table_split                Perl_ptr_table_split
 #endif
+#if defined(HAVE_INTERP_INTERN)
+#define Perl_sys_intern_init   CPerlObj::Perl_sys_intern_init
+#define sys_intern_init                Perl_sys_intern_init
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif

diff --git a/embed.pl b/embed.pl
index eb7e38c..bbea4dc 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -2161,6 +2161,9 @@ Ap        |void*  |ptr_table_fetch|PTR_TBL_t *tbl|void *sv
 Ap     |void   |ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv
 Ap     |void   |ptr_table_split|PTR_TBL_t *tbl
 #endif
+#if defined(HAVE_INTERP_INTERN)
+Ap     |void   |sys_intern_init
+#endif
 
 #if defined(PERL_OBJECT)
 protected:

diff --git a/global.sym b/global.sym
index 8aca76e..796f851 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -540,3 +540,4 @@ Perl_ptr_table_new
 Perl_ptr_table_fetch
 Perl_ptr_table_store
 Perl_ptr_table_split
+Perl_sys_intern_init

diff --git a/makedef.pl b/makedef.pl
index e63034b..6fae88b 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -260,6 +260,7 @@ elsif ($PLATFORM eq 'aix') {
                     Perl_same_dirent
                     Perl_unlnk
                     Perl_sys_intern_dup
+                    Perl_sys_intern_init
                     PL_cryptseen
                     PL_opsave
                     PL_statusvalue_vms

diff --git a/objXSUB.h b/objXSUB.h
index 8a0a81e..97e9ba4 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -2184,6 +2184,12 @@
 #undef  ptr_table_split
 #define ptr_table_split                Perl_ptr_table_split
 #endif
+#if defined(HAVE_INTERP_INTERN)
+#undef  Perl_sys_intern_init
+#define Perl_sys_intern_init   pPerl->Perl_sys_intern_init
+#undef  sys_intern_init
+#define sys_intern_init                Perl_sys_intern_init
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif

diff --git a/perl.c b/perl.c
index 6244753..acf3bd8 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -272,6 +272,10 @@ perl_construct(pTHXx)
     PL_localpatches = local_patches;   /* For possible -v */
 #endif
 
+#ifdef HAVE_INTERP_INTERN
+    sys_intern_init();
+#endif
+
     PerlIO_init();                     /* Hook to IO system */
 
     PL_fdpid = newAV();                        /* for remembering popen pids by fd */
@@ -2505,7 +2509,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
        sv_catpvn(sv, "-I", 2);
        sv_catpv(sv,PRIVLIB_EXP);
 
-#ifdef MSDOS
+#if defined(MSDOS) || defined(WIN32)
        Perl_sv_setpvf(aTHX_ cmd, "\
 sed %s -e \"/^[^#]/b\" \
  -e \"/^#[     ]*include[      ]/b\" \

diff --git a/perlapi.c b/perlapi.c
index fc71fb3..125c6e1 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -3943,6 +3943,15 @@ Perl_ptr_table_split(pTHXo_ PTR_TBL_t *tbl)
     ((CPerlObj*)pPerl)->Perl_ptr_table_split(tbl);
 }
 #endif
+#if defined(HAVE_INTERP_INTERN)
+
+#undef  Perl_sys_intern_init
+void
+Perl_sys_intern_init(pTHXo)
+{
+    ((CPerlObj*)pPerl)->Perl_sys_intern_init();
+}
+#endif
 #if defined(PERL_OBJECT)
 #else
 #endif

diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index 0109b27..58e2951 100644 (file)
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -1597,17 +1597,17 @@ false, defined or undefined.  Does not handle 'get' magic.
 
        bool    SvTRUE(SV* sv)
 
+=item svtype
+
+An enum of flags for Perl types.  These are found in the file B<sv.h> 
+in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
+
 =item SvTYPE
 
 Returns the type of the SV.  See C<svtype>.
 
        svtype  SvTYPE(SV* sv)
 
-=item svtype
-
-An enum of flags for Perl types.  These are found in the file B<sv.h> 
-in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
-
 =item SVt_IV
 
 Integer type flag for scalars.  See C<svtype>.

diff --git a/proto.h b/proto.h
index 454ca54..3e0aaef 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -938,6 +938,9 @@ PERL_CALLCONV void* Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv);
 PERL_CALLCONV void     Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldsv, void *newsv);
 PERL_CALLCONV void     Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl);
 #endif
+#if defined(HAVE_INTERP_INTERN)
+PERL_CALLCONV void     Perl_sys_intern_init(pTHX);
+#endif
 
 #if defined(PERL_OBJECT)
 protected:

diff --git a/win32/win32.c b/win32/win32.c
index 008d7e0..c589ff5 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -3968,18 +3968,6 @@ Perl_init_os_extras(void)
     char *file = __FILE__;
     dXSUB_SYS;
 
-    w32_perlshell_tokens = Nullch;
-    w32_perlshell_items = -1;
-    w32_fdpid = newAV();               /* XXX needs to be in Perl_win32_init()? */
-    New(1313, w32_children, 1, child_tab);
-    w32_num_children = 0;
-    w32_init_socktype = 0;
-#ifdef USE_ITHREADS
-    w32_pseudo_id = 0;
-    New(1313, w32_pseudo_children, 1, child_tab);
-    w32_num_pseudo_children = 0;
-#endif
-
     /* these names are Activeware compatible */
     newXS("Win32::GetCwd", w32_GetCwd, file);
     newXS("Win32::SetCwd", w32_SetCwd, file);
@@ -4037,16 +4025,36 @@ win32_get_child_IO(child_IO_table* ptbl)
     ptbl->childStdErr  = GetStdHandle(STD_ERROR_HANDLE);
 }
 
-
-#ifdef USE_ITHREADS
+#ifdef HAVE_INTERP_INTERN
 
 #  ifdef PERL_OBJECT
+#    undef Perl_sys_intern_init
+#    define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init
 #    undef Perl_sys_intern_dup
 #    define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup
 #    define pPerl this
 #  endif
 
 void
+Perl_sys_intern_init(pTHX)
+{
+    w32_perlshell_tokens       = Nullch;
+    w32_perlshell_vec          = (char**)NULL;
+    w32_perlshell_items                = 0;
+    w32_fdpid                  = newAV();
+    New(1313, w32_children, 1, child_tab);
+    w32_num_children           = 0;
+#  ifdef USE_ITHREADS
+    w32_pseudo_id              = 0;
+    New(1313, w32_pseudo_children, 1, child_tab);
+    w32_num_pseudo_children    = 0;
+#  endif
+    w32_init_socktype          = 0;
+}
+
+#  ifdef USE_ITHREADS
+
+void
 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
 {
     dst->perlshell_tokens      = Nullch;
@@ -4054,12 +4062,12 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
     dst->perlshell_items       = 0;
     dst->fdpid                 = newAV();
     Newz(1313, dst->children, 1, child_tab);
-    Newz(1313, dst->pseudo_children, 1, child_tab);
     dst->pseudo_id             = 0;
-    dst->children->num         = 0;
+    Newz(1313, dst->pseudo_children, 1, child_tab);
     dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype;
 }
-#endif
+#  endif /* USE_ITHREADS */
+#endif /* HAVE_INTERP_INTERN */
 
 #ifdef PERL_OBJECT
 #  undef this