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 e90cd59..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,23 +1619,29 @@ 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));
 
-    /* XXX Once it's possible, we need to
-       detect that our @ISA is aliased in
-       other stashes, and act on the stashes
-       of all of the aliases */
+    if (SvTYPE(mg->mg_obj) != SVt_PVGV && SvSMAGICAL(mg->mg_obj))
+       /* This occurs with setisa_elem magic, which calls this
+          same function. */
+       mg = mg_find(mg->mg_obj, PERL_MAGIC_isa);
+
+    if (SvTYPE(mg->mg_obj) == SVt_PVAV) { /* multiple stashes */
+       SV **svp = AvARRAY((AV *)mg->mg_obj);
+       I32 items = AvFILLp((AV *)mg->mg_obj) + 1;
+       while (items--) {
+           stash = GvSTASH((GV *)*svp++);
+           if (stash && HvENAME(stash)) mro_isa_changed_in(stash);
+       }
+
+       return 0;
+    }
 
-    /* The first case occurs via setisa,
-       the second via setisa_elem, which
-       calls this same magic */
     stash = GvSTASH(
-        SvTYPE(mg->mg_obj) == SVt_PVGV
-            ? (const GV *)mg->mg_obj
-            : (const GV *)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
+        (const GV *)mg->mg_obj
     );
 
     /* The stash may have been detached from the symbol table, so check its
@@ -2383,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;
 
@@ -2419,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));
@@ -2945,12 +2967,6 @@ Perl_sighandler(int sig)
     XPV * const tXpv = PL_Xpv;
     I32 old_ss_ix = PL_savestack_ix;
 
-    if (PL_savestack_ix + 15 <= PL_savestack_max)
-       flags |= 1;
-    if (PL_markstack_ptr < PL_markstack_max - 2)
-       flags |= 4;
-    if (PL_scopestack_ix < PL_scopestack_max - 3)
-       flags |= 16;
 
     if (!PL_psig_ptr[sig]) {
                PerlIO_printf(Perl_error_log, "Signal SIG%s received, but no signal handler set.\n",
@@ -2960,14 +2976,19 @@ Perl_sighandler(int sig)
 
     /* Max number of items pushed there is 3*n or 4. We cannot fix
        infinity, so we fix 4 (in fact 5): */
-    if (flags & 1) {
+    if (PL_savestack_ix + 15 <= PL_savestack_max) {
+       flags |= 1;
        PL_savestack_ix += 5;           /* Protect save in progress. */
        SAVEDESTRUCTOR_X(S_unwind_handler_stack, NULL);
     }
-    if (flags & 4)
+    if (PL_markstack_ptr < PL_markstack_max - 2) {
+       flags |= 2;
        PL_markstack_ptr++;             /* Protect mark. */
-    if (flags & 16)
-       PL_scopestack_ix += 1;
+    }
+    if (PL_scopestack_ix < PL_scopestack_max - 3) {
+       flags |= 4;
+       PL_scopestack_ix++;
+    }
     /* sv_2cv is too complicated, try a simpler variant first: */
     if (!SvROK(PL_psig_ptr[sig]) || !(cv = MUTABLE_CV(SvRV(PL_psig_ptr[sig])))
        || SvTYPE(cv) != SVt_PVCV) {
@@ -2987,7 +3008,7 @@ Perl_sighandler(int sig)
     sv = PL_psig_name[sig]
            ? SvREFCNT_inc_NN(PL_psig_name[sig])
            : newSVpv(PL_sig_name[sig],0);
-    flags |= 64;
+    flags |= 8;
     SAVEFREESV(sv);
 
     /* make sure our assumption about the size of the SAVEs are correct:
@@ -3052,11 +3073,11 @@ Perl_sighandler(int sig)
 cleanup:
     /* pop any of SAVEFREESV, SAVEDESTRUCTOR_X and "save in progress" */
     PL_savestack_ix = old_ss_ix;
-    if (flags & 4)
+    if (flags & 2)
        PL_markstack_ptr--;
-    if (flags & 16)
+    if (flags & 4)
        PL_scopestack_ix -= 1;
-    if (flags & 64)
+    if (flags & 8)
        SvREFCNT_dec(sv);
     PL_op = myop;                      /* Apparently not needed... */