undef *glob should update isa(rev)

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index b777f39..4ae130b 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -139,10 +139,11 @@ PP(pp_rv2gv)
 {
     dVAR; dSP; dTOPss;
 
-    SvGETMAGIC(sv);
+    if (!isGV(sv) || SvFAKE(sv)) SvGETMAGIC(sv);
     if (SvROK(sv)) {
       wasref:
-       tryAMAGICunDEREF(to_gv);
+       sv = amagic_deref_call(sv, to_gv_amg);
+       SPAGAIN;
 
        sv = SvRV(sv);
        if (SvTYPE(sv) == SVt_PVIO) {
@@ -213,11 +214,19 @@ PP(pp_rv2gv)
                }
                sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD, SVt_PVGV));
            }
+           /* FAKE globs in the symbol table cause weird bugs (#77810) */
+           if (sv) SvFAKE_off(sv);
        }
     }
     if (PL_op->op_private & OPpLVAL_INTRO)
        save_gp(MUTABLE_GV(sv), !(PL_op->op_flags & OPf_SPECIAL));
-    SETs(sv);
+    if (sv && SvFAKE(sv)) {
+       SV *newsv = sv_newmortal();
+       sv_setsv_flags(newsv, sv, 0);
+       SvFAKE_off(newsv);
+       SETs(newsv);
+    }
+    else SETs(sv);
     RETURN;
 }
 
@@ -275,7 +284,8 @@ PP(pp_rv2sv)
     if (!(PL_op->op_private & OPpDEREFed))
        SvGETMAGIC(sv);
     if (SvROK(sv)) {
-       tryAMAGICunDEREF(to_sv);
+       sv = amagic_deref_call(sv, to_sv_amg);
+       SPAGAIN;
 
        sv = SvRV(sv);
        switch (SvTYPE(sv)) {
@@ -421,7 +431,19 @@ PP(pp_prototype)
                    goto set;
                }
                if (code == -KEY_keys || code == -KEY_values || code == -KEY_each) {
-                   ret = newSVpvs_flags("\\[@%]", SVs_TEMP);
+                   ret = newSVpvs_flags("+", SVs_TEMP);
+                   goto set;
+               }
+               if (code == -KEY_push || code == -KEY_unshift) {
+                   ret = newSVpvs_flags("+@", SVs_TEMP);
+                   goto set;
+               }
+               if (code == -KEY_pop || code == -KEY_shift) {
+                   ret = newSVpvs_flags(";+", SVs_TEMP);
+                   goto set;
+               }
+               if (code == -KEY_splice) {
+                   ret = newSVpvs_flags("+;$$@", SVs_TEMP);
                    goto set;
                }
                if (code == -KEY_tied || code == -KEY_untie) {
@@ -755,7 +777,12 @@ PP(pp_trans)
        EXTEND(SP,1);
     }
     TARG = sv_newmortal();
-    PUSHi(do_trans(sv));
+    if(PL_op->op_type == OP_TRANSR) {
+       SV * const newsv = newSVsv(sv);
+       do_trans(newsv);
+       mPUSHs(newsv);
+    }
+    else PUSHi(do_trans(sv));
     RETURN;
 }
 
@@ -845,13 +872,16 @@ PP(pp_undef)
            GP *gp;
             HV *stash;
 
-            /* undef *Foo:: */
-            if((stash = GvHV((const GV *)sv)) && HvNAME_get(stash))
-                mro_isa_changed_in(stash);
             /* undef *Pkg::meth_name ... */
-            else if(GvCVu((const GV *)sv) && (stash = GvSTASH((const GV *)sv))
-                   && HvNAME_get(stash))
-                mro_method_changed_in(stash);
+            bool method_changed
+             =   GvCVu((const GV *)sv) && (stash = GvSTASH((const GV *)sv))
+             && HvENAME_get(stash);
+            /* undef *Foo:: */
+            if((stash = GvHV((const GV *)sv))) {
+                if(HvENAME_get(stash))
+                    SvREFCNT_inc_simple_void_NN(sv_2mortal((SV *)stash));
+                else stash = NULL;
+            }
 
            gp_free(MUTABLE_GV(sv));
            Newxz(gp, 1, GP);
@@ -860,6 +890,20 @@ PP(pp_undef)
            GvLINE(sv) = CopLINE(PL_curcop);
            GvEGV(sv) = MUTABLE_GV(sv);
            GvMULTI_on(sv);
+
+            if(stash)
+                mro_package_moved(NULL, stash, (const GV *)sv, NULL, 0);
+            stash = NULL;
+            /* undef *Foo::ISA */
+            if( strEQ(GvNAME((const GV *)sv), "ISA")
+             && (stash = GvSTASH((const GV *)sv))
+             && (method_changed || HvENAME(stash)) )
+                mro_isa_changed_in(stash);
+            else if(method_changed)
+                mro_method_changed_in(
+                 stash ? stash : GvSTASH((const GV *)sv)
+                );
+
            break;
        }
        /* FALL THROUGH */
@@ -2449,7 +2493,7 @@ PP(pp_negate)
        SV * const sv = TOPs;
        const int flags = SvFLAGS(sv);
 
-        if( looks_like_number( sv ) ){
+        if( !SvNIOK( sv ) && looks_like_number( sv ) ){
            SvIV_please( sv );
         }   
 
@@ -4617,6 +4661,71 @@ PP(pp_aslice)
     RETURN;
 }
 
+/* Smart dereferencing for keys, values and each */
+PP(pp_rkeys)
+{
+    dVAR;
+    dSP;
+    dPOPss;
+
+    if (!SvOK(sv))
+       RETURN;
+
+    if (SvROK(sv)) {
+       SvGETMAGIC(sv);
+       if (SvAMAGIC(sv)) {
+           /* N.B.: AMG macros return sv if no overloading is found */
+           SV *maybe_hv = AMG_CALLun(sv,to_hv);
+           SV *maybe_av = AMG_CALLun(sv,to_av);
+           if ( maybe_hv != sv && maybe_av != sv ) {
+               Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
+                   Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as %%{}",
+                       PL_op_desc[PL_op->op_type]
+                   )
+               );
+               sv = maybe_hv;
+           }
+           else if ( maybe_av != sv ) {
+               if ( SvTYPE(SvRV(sv)) == SVt_PVHV ) {
+                   /* @{} overload, but underlying reftype is HV */
+                   Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
+                       Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as @{}",
+                           PL_op_desc[PL_op->op_type]
+                       )
+                   );
+               }
+               sv = maybe_av;
+           }
+           else if ( maybe_hv != sv ) {
+               if ( SvTYPE(SvRV(sv)) == SVt_PVAV ) {
+                   /* %{} overload, but underlying reftype is AV */
+                   Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
+                       Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as %%{}",
+                           PL_op_desc[PL_op->op_type]
+                       )
+                   );
+               }
+               sv = maybe_hv;
+           }
+       }
+       sv = SvRV(sv);
+    }
+
+    if ( SvTYPE(sv) != SVt_PVHV && SvTYPE(sv) != SVt_PVAV ) {
+       DIE(aTHX_ Perl_form(aTHX_ "Type of argument to %s must be hashref or arrayref",
+           PL_op_desc[PL_op->op_type] ));
+    }
+
+    /* Delegate to correct function for op type */
+    PUSHs(sv);
+    if (PL_op->op_type == OP_RKEYS || PL_op->op_type == OP_RVALUES) {
+       return (SvTYPE(sv) == SVt_PVHV) ? Perl_do_kv(aTHX) : Perl_pp_akeys(aTHX);
+    }
+    else {
+       return (SvTYPE(sv) == SVt_PVHV) ? Perl_pp_each(aTHX) : Perl_pp_aeach(aTHX);
+    }
+}
+
 PP(pp_aeach)
 {
     dVAR;
@@ -4662,7 +4771,7 @@ PP(pp_akeys)
 
         EXTEND(SP, n + 1);
 
-       if (PL_op->op_type == OP_AKEYS) {
+       if (PL_op->op_type == OP_AKEYS || PL_op->op_type == OP_RKEYS) {
            n += i;
            for (;  i <= n;  i++) {
                mPUSHi(i);