manual integrate of change#16332 from maint-5.6 branch

p4raw-link: @16332 on //depot/maint-5.6/perl: 9bf7742e23b67e3d7c671615795c570c51951513

p4raw-id: //depot/perl@16348

diff --git a/mg.c b/mg.c
index 9249df2..63de612 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -990,11 +990,16 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 #if defined(VMS) || defined(EPOC)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
 #else
-#   if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
+#  if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
     PerlEnv_clearenv();
-#   else
-#       ifdef USE_ENVIRON_ARRAY
-#          ifndef PERL_USE_SAFE_PUTENV
+#  else
+#    ifdef USE_ENVIRON_ARRAY
+#      if defined(USE_ITHREADS)
+    /* only the parent thread can clobber the process environment */
+    if (PL_curinterp == aTHX)
+#      endif
+    {
+#      ifndef PERL_USE_SAFE_PUTENV
     I32 i;
 
     if (environ == PL_origenviron)
@@ -1002,11 +1007,11 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
     else
        for (i = 0; environ[i]; i++)
            safesysfree(environ[i]);
-#          endif /* PERL_USE_SAFE_PUTENV */
+#      endif /* PERL_USE_SAFE_PUTENV */
 
     environ[0] = Nullch;
-
-#       endif /* USE_ENVIRON_ARRAY */
+    }
+#    endif /* USE_ENVIRON_ARRAY */
 #   endif /* PERL_IMPLICIT_SYS || WIN32 */
 #endif /* VMS || EPC */
     return 0;
@@ -2239,7 +2244,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                    break;
            }
            /* can grab env area too? */
-           if (PL_origenviron && (PL_origenviron[0] == s + 1)) {
+           if (PL_origenviron
+#ifdef USE_ITHREADS
+               && PL_curinterp == aTHX
+#endif
+               && (PL_origenviron[0] == s + 1))
+           {
                my_setenv("NoNe  SuCh", Nullch);
                                            /* force copy of environment */
                for (i = 0; PL_origenviron[i]; i++)

diff --git a/perl.c b/perl.c
index 7164d55..5230114 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -498,7 +498,13 @@ perl_destruct(pTHXx)
      * so we certainly shouldn't free it here
      */
 #if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV)
-    if (environ != PL_origenviron) {
+    if (environ != PL_origenviron
+#ifdef USE_ITHREADS
+       /* only main thread can free environ[0] contents */
+       && PL_curinterp == aTHX
+#endif
+       )
+    {
        I32 i;
 
        for (i = 0; environ[i]; i++)
@@ -3576,8 +3582,14 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
        */
        if (!env)
            env = environ;
-       if (env != environ)
+       if (env != environ
+#  ifdef USE_ITHREADS
+           && PL_curinterp == aTHX
+#  endif
+          )
+       {
            environ[0] = Nullch;
+       }
        if (env)
          for (; *env; env++) {
            if (!(s = strchr(*env,'=')))

diff --git a/sv.c b/sv.c
index 0350bae..9ba91e6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6594,8 +6594,14 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
                if (GvHV(gv) && !HvNAME(GvHV(gv))) {
                    hv_clear(GvHV(gv));
 #ifdef USE_ENVIRON_ARRAY
-                   if (gv == PL_envgv)
+                   if (gv == PL_envgv
+#  ifdef USE_ITHREADS
+                       && PL_curinterp == aTHX
+#  endif
+                   )
+                   {
                        environ[0] = Nullch;
+                   }
 #endif
                }
            }

diff --git a/util.c b/util.c
index 35d54c3..fe93c99 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1594,6 +1594,11 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 void
 Perl_my_setenv(pTHX_ char *nam, char *val)
 {
+#ifdef USE_ITHREADS
+  /* only parent thread can modify process environment */
+  if (PL_curinterp == aTHX)
+#endif
+  {
 #ifndef PERL_USE_SAFE_PUTENV
     /* most putenv()s leak, so we manipulate environ directly */
     register I32 i=setenv_getix(nam);          /* where does it go? */
@@ -1652,6 +1657,7 @@ Perl_my_setenv(pTHX_ char *nam, char *val)
     (void)putenv(new_env);
 #   endif /* __CYGWIN__ */
 #endif  /* PERL_USE_SAFE_PUTENV */
+  }
 }
 
 #else /* WIN32 || NETWARE */