Avoid loading Config, as we don't need to distinguish between NetWare and Win32.

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

diff --git a/pp_hot.c b/pp_hot.c
index f0c56cf..7afa422 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1783,28 +1783,24 @@ PP(pp_helem)
     const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
     SV *sv;
     const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvSHARED_HASH(keysv) : 0;
-    I32 preeminent = 0;
+    const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+    bool preeminent = TRUE;
 
     if (SvTYPE(hv) != SVt_PVHV)
        RETPUSHUNDEF;
 
-    if (PL_op->op_private & OPpLVAL_INTRO) {
+    if (localizing) {
        MAGIC *mg;
        HV *stash;
-       /* does the element we're localizing already exist? */
-       preeminent = /* can we determine whether it exists? */
-           (    !SvRMAGICAL(hv)
-               || mg_find((const SV *)hv, PERL_MAGIC_env)
-               || (     (mg = mg_find((const 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(MUTABLE_SV(hv), mg))))
-                   && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
-                   && gv_fetchmethod_autoload(stash, "DELETE", TRUE)
-               )
-           ) ? hv_exists_ent(hv, keysv, 0) : 1;
+
+       /* If we can determine whether the element exist,
+        * Try to preserve the existenceness of a tied hash
+        * element by using EXISTS and DELETE if possible.
+        * Fallback to FETCH and STORE otherwise. */
+       if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+           preeminent = hv_exists_ent(hv, keysv, 0);
     }
+
     he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
     svp = he ? &HeVAL(he) : NULL;
     if (lval) {
@@ -1824,7 +1820,7 @@ PP(pp_helem)
            PUSHs(lv);
            RETURN;
        }
-       if (PL_op->op_private & OPpLVAL_INTRO) {
+       if (localizing) {
            if (HvNAME_get(hv) && isGV(*svp))
                save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
            else {
@@ -2918,6 +2914,8 @@ PP(pp_aelem)
     AV *const av = MUTABLE_AV(POPs);
     const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
     const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
+    const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+    bool preeminent = TRUE;
     SV *sv;
 
     if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
@@ -2928,6 +2926,19 @@ PP(pp_aelem)
        elem -= CopARYBASE_get(PL_curcop);
     if (SvTYPE(av) != SVt_PVAV)
        RETPUSHUNDEF;
+
+    if (localizing) {
+       MAGIC *mg;
+       HV *stash;
+
+       /* If we can determine whether the element exist,
+        * Try to preserve the existenceness of a tied array
+        * element by using EXISTS and DELETE if possible.
+        * Fallback to FETCH and STORE otherwise. */
+       if (SvCANEXISTDELETE(av))
+           preeminent = av_exists(av, elem);
+    }
+
     svp = av_fetch(av, elem, lval && !defer);
     if (lval) {
 #ifdef PERL_MALLOC_WRAP
@@ -2957,8 +2968,12 @@ PP(pp_aelem)
            PUSHs(lv);
            RETURN;
        }
-       if (PL_op->op_private & OPpLVAL_INTRO)
-           save_aelem(av, elem, svp);
+       if (localizing) {
+           if (preeminent)
+               save_aelem(av, elem, svp);
+           else
+               SAVEADELETE(av, elem);
+       }
        else if (PL_op->op_private & OPpDEREF)
            vivify_ref(*svp, PL_op->op_private & OPpDEREF);
     }
@@ -3029,17 +3044,16 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     SV* ob;
     GV* gv;
     HV* stash;
-    STRLEN namelen;
     const char* packname = NULL;
     SV *packsv = NULL;
     STRLEN packlen;
-    const char * const name = SvPV_const(meth, namelen);
     SV * const sv = *(PL_stack_base + TOPMARK + 1);
 
     PERL_ARGS_ASSERT_METHOD_COMMON;
 
     if (!sv)
-       Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
+       Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on an undefined value",
+                  SVfARG(meth));
 
     SvGETMAGIC(sv);
     if (SvROK(sv))
@@ -3068,7 +3082,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
                    : !isIDFIRST(*packname)
                ))
            {
-               Perl_croak(aTHX_ "Can't call method \"%s\" %s", name,
+               Perl_croak(aTHX_ "Can't call method \"%"SVf"\" %s",
+                          SVfARG(meth),
                           SvOK(sv) ? "without a package or object reference"
                                    : "on an undefined value");
            }
@@ -3093,6 +3108,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
                     && (ob = MUTABLE_SV(GvIO((const GV *)ob)))
                     && SvOBJECT(ob))))
     {
+       const char * const name = SvPV_nolen_const(meth);
        Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
                   (SvSCREAM(meth) && strEQ(name,"isa")) ? "DOES" :
                   name);
@@ -3116,7 +3132,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
        }
     }
 
-    gv = gv_fetchmethod_flags(stash ? stash : MUTABLE_HV(packsv), name,
+    gv = gv_fetchmethod_flags(stash ? stash : MUTABLE_HV(packsv),
+                             SvPV_nolen_const(meth),
                              GV_AUTOLOAD | GV_CROAK);
 
     assert(gv);