This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid redundant hv_delete call in pp_entereval
[perl5.git] / mg.c
diff --git a/mg.c b/mg.c
index 334eb80..e734d80 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -809,6 +809,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     switch (*mg->mg_ptr) {
     case '\001':               /* ^A */
        sv_setsv(sv, PL_bodytarget);
+       if (SvTAINTED(PL_bodytarget))
+           SvTAINTED_on(sv);
        break;
     case '\003':               /* ^C, ^CHILD_ERROR_NATIVE */
        if (nextchar == '\0') {
@@ -877,6 +879,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '\006':               /* ^F */
        sv_setiv(sv, (IV)PL_maxsysfd);
        break;
+    case '\007':               /* ^GLOBAL_PHASE */
+       if (strEQ(remaining, "LOBAL_PHASE")) {
+           sv_setpvn(sv, PL_phase_names[PL_phase],
+                     strlen(PL_phase_names[PL_phase]));
+       }
+       break;
     case '\010':               /* ^H */
        sv_setiv(sv, (IV)PL_hints);
        break;
@@ -892,7 +900,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            Perl_emulate_cop_io(aTHX_ &PL_compiling, sv);
        }
        break;
-    case '\020':               
+    case '\020':
        if (nextchar == '\0') {       /* ^P */
            sv_setiv(sv, (IV)PL_perldb);
        } else if (strEQ(remaining, "REMATCH")) { /* $^PREMATCH */
@@ -1611,7 +1619,7 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_CLEARISA;
 
     /* Bail out if destruction is going on */
-    if(PL_dirty) return 0;
+    if(PL_phase == PERL_PHASE_DESTRUCT) return 0;
 
     if (sv)
        av_clear(MUTABLE_AV(sv));
@@ -2389,6 +2397,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     const char * const remaining = mg->mg_ptr + 1;
     I32 i;
     STRLEN len;
+    MAGIC *tmg;
 
     PERL_ARGS_ASSERT_MAGIC_SET;
 
@@ -2425,6 +2434,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
         break;
     case '\001':       /* ^A */
        sv_setsv(PL_bodytarget, sv);
+       /* mg_set() has temporarily made sv non-magical */
+       if (PL_tainting) {
+           if ((tmg = mg_find(sv,PERL_MAGIC_taint)) && tmg->mg_len & 1)
+               SvTAINTED_on(PL_bodytarget);
+           else
+               SvTAINTED_off(PL_bodytarget);
+       }
        break;
     case '\003':       /* ^C */
        PL_minus_c = cBOOL(SvIV(sv));