From: Gurusamy Sarathy <gsar@cpan.org>
Date: Thu, 2 May 2002 15:44:48 +0000 (+0000)
Subject: manual integrate of change#16332 from maint-5.6 branch
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4efc5df63c21e7be3ddafb142377fe2511926c04;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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 */