Quieten warnings in Deparse.pm

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

diff --git a/pp.c b/pp.c
index 7ff5138..b3a6eed 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -764,8 +764,7 @@ PP(pp_undef)
     if (!sv)
        RETPUSHUNDEF;
 
-    if (SvTHINKFIRST(sv))
-       sv_force_normal(sv);
+    SV_CHECK_THINKFIRST_COW_DROP(sv);
 
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -956,6 +955,8 @@ PP(pp_pow)
                             result *= base;
                             /* Only bother to clear the bit if it is set.  */
                             power &= ~bit;
+                           /* Avoid squaring base again if we're done. */
+                           if (power == 0) break;
                         }
                     }
                     SP--;
@@ -3305,12 +3306,12 @@ PP(pp_crypt)
 #   else
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
 #   endif
+    SETs(TARG);
+    RETURN;
 #else
     DIE(aTHX_
       "The crypt() function is unimplemented due to excessive paranoia.");
 #endif
-    SETs(TARG);
-    RETURN;
 }
 
 PP(pp_ucfirst)
@@ -3681,11 +3682,10 @@ PP(pp_each)
     HV *hash = (HV*)POPs;
     HE *entry;
     I32 gimme = GIMME_V;
-    I32 realhv = (SvTYPE(hash) == SVt_PVHV);
 
     PUTBACK;
     /* might clobber stack_sp */
-    entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
+    entry = hv_iternext(hash);
     SPAGAIN;
 
     EXTEND(SP, 2);
@@ -3696,8 +3696,7 @@ PP(pp_each)
            SV *val;
            PUTBACK;
            /* might clobber stack_sp */
-           val = realhv ?
-                 hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
+           val = hv_iterval(hash, entry);
            SPAGAIN;
            PUSHs(val);
        }
@@ -3737,19 +3736,13 @@ PP(pp_delete)
                *MARK = sv ? sv : &PL_sv_undef;
            }
        }
-       else if (hvtype == SVt_PVAV) {
-           if (PL_op->op_flags & OPf_SPECIAL) {        /* array element */
-               while (++MARK <= SP) {
-                   sv = av_delete((AV*)hv, SvIV(*MARK), discard);
-                   *MARK = sv ? sv : &PL_sv_undef;
-               }
-           }
-           else {                                      /* pseudo-hash element */
-               while (++MARK <= SP) {
-                   sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
-                   *MARK = sv ? sv : &PL_sv_undef;
-               }
-           }
+       else if (hvtype == SVt_PVAV) {                  /* array element */
+            if (PL_op->op_flags & OPf_SPECIAL) {
+                while (++MARK <= SP) {
+                    sv = av_delete((AV*)hv, SvIV(*MARK), discard);
+                    *MARK = sv ? sv : &PL_sv_undef;
+                }
+            }
        }
        else
            DIE(aTHX_ "Not a HASH reference");
@@ -3770,7 +3763,7 @@ PP(pp_delete)
            if (PL_op->op_flags & OPf_SPECIAL)
                sv = av_delete((AV*)hv, SvIV(keysv), discard);
            else
-               sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
+               DIE(aTHX_ "panic: avhv_delete no longer supported");
        }
        else
            DIE(aTHX_ "Not a HASH reference");
@@ -3810,8 +3803,6 @@ PP(pp_exists)
            if (av_exists((AV*)hv, SvIV(tmpsv)))
                RETPUSHYES;
        }
-       else if (avhv_exists_ent((AV*)hv, tmpsv, 0))    /* pseudo-hash element */
-           RETPUSHYES;
     }
     else {
        DIE(aTHX_ "Not a HASH reference");
@@ -3824,42 +3815,53 @@ PP(pp_hslice)
     dSP; dMARK; dORIGMARK;
     register HV *hv = (HV*)POPs;
     register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
-    I32 realhv = (SvTYPE(hv) == SVt_PVHV);
+    bool localizing = PL_op->op_private & OPpLVAL_INTRO ? TRUE : FALSE;
+    bool other_magic = FALSE;
+
+    if (localizing) {
+        MAGIC *mg;
+        HV *stash;
+
+        other_magic = mg_find((SV*)hv, PERL_MAGIC_env) ||
+            ((mg = mg_find((SV*)hv, PERL_MAGIC_tied))
+             /* Try to preserve the existenceness of a tied hash
+              * element by using EXISTS and DELETE if possible.
+              * Fallback to FETCH and STORE otherwise */
+             && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg))))
+             && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
+             && gv_fetchmethod_autoload(stash, "DELETE", TRUE));
+    }
+
+    while (++MARK <= SP) {
+        SV *keysv = *MARK;
+        SV **svp;
+        HE *he;
+        bool preeminent = FALSE;
+
+        if (localizing) {
+            preeminent = SvRMAGICAL(hv) && !other_magic ? 1 :
+                hv_exists_ent(hv, keysv, 0);
+        }
 
-    if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
-       DIE(aTHX_ "Can't localize pseudo-hash element");
+        he = hv_fetch_ent(hv, keysv, lval, 0);
+        svp = he ? &HeVAL(he) : 0;
 
-    if (realhv || SvTYPE(hv) == SVt_PVAV) {
-       while (++MARK <= SP) {
-           SV *keysv = *MARK;
-           SV **svp;
-           I32 preeminent = SvRMAGICAL(hv) ? 1 :
-                               realhv ? hv_exists_ent(hv, keysv, 0)
-                                      : avhv_exists_ent((AV*)hv, keysv, 0);
-           if (realhv) {
-               HE *he = hv_fetch_ent(hv, keysv, lval, 0);
-               svp = he ? &HeVAL(he) : 0;
-           }
-           else {
-               svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
-           }
-           if (lval) {
-               if (!svp || *svp == &PL_sv_undef) {
-                   STRLEN n_a;
-                   DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
-               }
-               if (PL_op->op_private & OPpLVAL_INTRO) {
-                   if (preeminent)
-                       save_helem(hv, keysv, svp);
-                   else {
-                       STRLEN keylen;
-                       char *key = SvPV(keysv, keylen);
-                       SAVEDELETE(hv, savepvn(key,keylen), keylen);
-                   }
+        if (lval) {
+            if (!svp || *svp == &PL_sv_undef) {
+                STRLEN n_a;
+                DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
+            }
+            if (localizing) {
+                if (preeminent)
+                    save_helem(hv, keysv, svp);
+                else {
+                    STRLEN keylen;
+                    char *key = SvPV(keysv, keylen);
+                    SAVEDELETE(hv, savepvn(key,keylen), keylen);
                 }
-           }
-           *MARK = svp ? *svp : &PL_sv_undef;
-       }
+            }
+        }
+        *MARK = svp ? *svp : &PL_sv_undef;
     }
     if (GIMME != G_ARRAY) {
        MARK = ORIGMARK;
@@ -4588,8 +4590,12 @@ PP(pp_split)
        iters++;
     }
     else if (!origlimit) {
-       while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
-           iters--, SP--;
+       while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) {
+           if (TOPs && !make_mortal)
+               sv_2mortal(TOPs);
+           iters--;
+           SP--;
+       }
     }
 
     if (realarray) {