Add mutex for accessing ENV

diff --git a/dosish.h b/dosish.h
index 98f8f99..5b27160 100644 (file)
--- a/dosish.h
+++ b/dosish.h
@@ -51,7 +51,8 @@
 #  define PERL_SYS_TERM_BODY()                         \
     HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM;      \
     OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; PERLIO_TERM;  \
-    MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;
+    MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;    \
+    ENV_TERM;
 #endif
 #define dXSUB_SYS dNOOP
 

diff --git a/embedvar.h b/embedvar.h
index dff0af6..5b6aa2b 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -397,6 +397,8 @@
 #define PL_Gdo_undump          (my_vars->Gdo_undump)
 #define PL_dollarzero_mutex    (my_vars->Gdollarzero_mutex)
 #define PL_Gdollarzero_mutex   (my_vars->Gdollarzero_mutex)
+#define PL_env_mutex           (my_vars->Genv_mutex)
+#define PL_Genv_mutex          (my_vars->Genv_mutex)
 #define PL_fold_locale         (my_vars->Gfold_locale)
 #define PL_Gfold_locale                (my_vars->Gfold_locale)
 #define PL_hash_chars          (my_vars->Ghash_chars)

diff --git a/makedef.pl b/makedef.pl
index 5fbca37..f0805e9 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -399,6 +399,7 @@ unless ($define{'USE_ITHREADS'}) {
                    PL_regex_pad
                    PL_regex_padav
                    PL_dollarzero_mutex
+                   PL_env_mutex
                    PL_hints_mutex
                    PL_locale_mutex
                    PL_lc_numeric_mutex

diff --git a/perl.c b/perl.c
index 6d1fff3..dc555fb 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -96,6 +96,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
        HINTS_REFCNT_INIT;
         LOCALE_INIT;
         USER_PROP_MUTEX_INIT;
+        ENV_INIT;
        MUTEX_INIT(&PL_dollarzero_mutex);
        MUTEX_INIT(&PL_my_ctx_mutex);
 #  endif

diff --git a/perl.h b/perl.h
index b8f6972..c734548 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2907,6 +2907,21 @@ typedef struct padname PADNAME;
 #  define USE_ENVIRON_ARRAY
 #endif
 
+#ifdef USE_ITHREADS
+   /* On some platforms it would be safe to use a read/write mutex with many
+    * readers possible at the same time.  On other platforms, notably IBM ones,
+    * subsequent getenv calls destroy earlier ones.  Those platforms would not
+    * be able to handle simultaneous getenv calls */
+#  define ENV_LOCK            MUTEX_LOCK(&PL_env_mutex)
+#  define ENV_UNLOCK          MUTEX_UNLOCK(&PL_env_mutex)
+#  define ENV_INIT            MUTEX_INIT(&PL_env_mutex);
+#  define ENV_TERM            MUTEX_DESTROY(&PL_env_mutex);
+#else
+#  define ENV_LOCK       NOOP;
+#  define ENV_UNLOCK     NOOP;
+#  define ENV_INIT       NOOP;
+#  define ENV_TERM       NOOP;
+#endif
 
 #if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
     /* having sigaction(2) means that the OS supports both 1-arg and 3-arg

diff --git a/perlapi.h b/perlapi.h
index 2214934..f3ef930 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -119,6 +119,8 @@ END_EXTERN_C
 #define PL_do_undump           (*Perl_Gdo_undump_ptr(NULL))
 #undef  PL_dollarzero_mutex
 #define PL_dollarzero_mutex    (*Perl_Gdollarzero_mutex_ptr(NULL))
+#undef  PL_env_mutex
+#define PL_env_mutex           (*Perl_Genv_mutex_ptr(NULL))
 #undef  PL_fold_locale
 #define PL_fold_locale         (*Perl_Gfold_locale_ptr(NULL))
 #undef  PL_hash_chars

diff --git a/perlvars.h b/perlvars.h
index 5a351a0..24ff324 100644 (file)
--- a/perlvars.h
+++ b/perlvars.h
@@ -104,6 +104,7 @@ PERLVARI(G, mmap_page_size, IV, 0)
 
 #if defined(USE_ITHREADS)
 PERLVAR(G, hints_mutex, perl_mutex)    /* Mutex for refcounted he refcounting */
+PERLVAR(G, env_mutex, perl_mutex)      /* Mutex for accessing ENV */
 #  if ! defined(USE_THREAD_SAFE_LOCALE) || defined(TS_W32_BROKEN_LOCALECONV)
 PERLVAR(G, locale_mutex, perl_mutex)   /* Mutex for setlocale() changing */
 #  endif

diff --git a/symbian/symbianish.h b/symbian/symbianish.h
index 3b8c0e7..3b0ddb3 100644 (file)
--- a/symbian/symbianish.h
+++ b/symbian/symbianish.h
@@ -122,7 +122,7 @@
 #ifndef PERL_SYS_TERM_BODY
 #define PERL_SYS_TERM_BODY()   HINTS_REFCNT_TERM; OP_REFCNT_TERM;          \
                                PERLIO_TERM; MALLOC_TERM; CloseSTDLIB();    \
-                                LOCALE_TERM
+                                LOCALE_TERM; ENV_TERM;
 
 #endif
 

diff --git a/unixish.h b/unixish.h
index 697a242..5bf5b93 100644 (file)
--- a/unixish.h
+++ b/unixish.h
@@ -142,6 +142,7 @@ int afstat(int fd, struct stat *statb);
     HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM;      \
     OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; PERLIO_TERM;  \
     MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;    \
+    ENV_TERM;                                          \
     amigaos4_dispose_fork_array();
 #endif
 
@@ -154,7 +155,8 @@ int afstat(int fd, struct stat *statb);
 #  define PERL_SYS_TERM_BODY()                         \
     HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM;      \
     OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; PERLIO_TERM;  \
-    MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;
+    MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;    \
+    ENV_TERM;
 
 #endif
 

diff --git a/vms/vmsish.h b/vms/vmsish.h
index 8dca211..3fae5d7 100644 (file)
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -310,7 +310,8 @@ struct interp_intern {
 #define BIT_BUCKET "/dev/null"
 #define PERL_SYS_INIT_BODY(c,v)        MALLOC_CHECK_TAINT2(*c,*v) vms_image_init((c),(v)); PERLIO_INIT; MALLOC_INIT
 #define PERL_SYS_TERM_BODY()    HINTS_REFCNT_TERM; OP_REFCNT_TERM;      \
-                                PERLIO_TERM; MALLOC_TERM; LOCALE_TERM
+                                PERLIO_TERM; MALLOC_TERM; LOCALE_TERM   \
+                                ENV_TERM;
 #define dXSUB_SYS dNOOP
 #define HAS_KILL
 #define HAS_WAIT

diff --git a/win32/win32.c b/win32/win32.c
index 874f27b..7f5482b 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -4553,6 +4553,7 @@ Perl_win32_term(void)
     PERLIO_TERM;
     MALLOC_TERM;
     LOCALE_TERM;
+    ENV_TERM;
 #ifndef WIN32_NO_REGISTRY
     /* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
        but no point of checking and we can't die() at this point */