add verbose stack display option, -Dvs

[p5sagit/p5-mst-13.2.git] / mg.c

diff --git a/mg.c b/mg.c
index 9249df2..1c7d239 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -693,18 +693,25 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 
              getrx:
                if (i >= 0) {
-                   bool was_tainted = FALSE;
-                   if (PL_tainting) {
-                       was_tainted = PL_tainted;
-                       PL_tainted = FALSE;
-                   }
                    sv_setpvn(sv, s, i);
-                   if (PL_reg_match_utf8 && is_utf8_string((U8*)s, i))
+                   if (PL_reg_match_utf8 && is_utf8_string((U8*)s, i))
                        SvUTF8_on(sv);
                    else
                        SvUTF8_off(sv);
-                   if (PL_tainting)
-                       PL_tainted = (was_tainted || RX_MATCH_TAINTED(rx));
+                   if (PL_tainting) {
+                       if (RX_MATCH_TAINTED(rx)) {
+                           MAGIC* mg = SvMAGIC(sv);
+                           MAGIC* mgt;
+                           PL_tainted = 1;
+                           SvMAGIC(sv) = mg->mg_moremagic;
+                           SvTAINT(sv);
+                           if ((mgt = SvMAGIC(sv))) {
+                               mg->mg_moremagic = mgt;
+                               SvMAGIC(sv) = mg;
+                           }
+                       } else
+                           SvTAINTED_off(sv);
+                   }
                    break;
                }
            }
@@ -990,11 +997,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 +1014,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 +2251,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++)