Amelioration of the error message "Unrecognized character %s in column %d"

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 739a457..9cedc3f 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2553,7 +2553,7 @@ PP(pp_complement)
              sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
              SvUTF8_off(TARG);
          }
-         SETs(TARG);
+         SETTARG;
          RETURN;
        }
 #ifdef LIBERAL
@@ -2569,8 +2569,7 @@ PP(pp_complement)
 #endif
        for ( ; anum > 0; anum--, tmps++)
            *tmps = ~*tmps;
-
-       SETs(TARG);
+       SETTARG;
       }
       RETURN;
     }
@@ -3514,7 +3513,7 @@ PP(pp_crypt)
 #   else
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right)));
 #   endif
-    SETs(TARG);
+    SETTARG;
     RETURN;
 #else
     DIE(aTHX_
@@ -3899,9 +3898,7 @@ PP(pp_quotemeta)
     }
     else
        sv_setpvn(TARG, s, len);
-    SETs(TARG);
-    if (SvSMAGICAL(TARG))
-       mg_set(TARG);
+    SETTARG;
     RETURN;
 }
 
@@ -3915,7 +3912,17 @@ PP(pp_aslice)
 
     if (SvTYPE(av) == SVt_PVAV) {
        const I32 arybase = CopARYBASE_get(PL_curcop);
-       if (lval && PL_op->op_private & OPpLVAL_INTRO) {
+       const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+       bool can_preserve = FALSE;
+
+       if (localizing) {
+           MAGIC *mg;
+           HV *stash;
+
+           can_preserve = SvCANEXISTDELETE(av);
+       }
+
+       if (lval && localizing) {
            register SV **svp;
            I32 max = -1;
            for (svp = MARK + 1; svp <= SP; svp++) {
@@ -3926,18 +3933,32 @@ PP(pp_aslice)
            if (max > AvMAX(av))
                av_extend(av, max);
        }
+
        while (++MARK <= SP) {
            register SV **svp;
            I32 elem = SvIV(*MARK);
+           bool preeminent = TRUE;
 
            if (elem > 0)
                elem -= arybase;
+           if (localizing && can_preserve) {
+               /* 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. */
+               preeminent = av_exists(av, elem);
+           }
+
            svp = av_fetch(av, elem, lval);
            if (lval) {
                if (!svp || *svp == &PL_sv_undef)
                    DIE(aTHX_ PL_no_aelem, elem);
-               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);
+               }
            }
            *MARK = svp ? *svp : &PL_sv_undef;
        }
@@ -4146,31 +4167,28 @@ PP(pp_hslice)
     register HV * const hv = MUTABLE_HV(POPs);
     register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
     const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
-    bool other_magic = FALSE;
+    bool can_preserve = FALSE;
 
     if (localizing) {
         MAGIC *mg;
         HV *stash;
 
-        other_magic = 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));
+       if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+           can_preserve = TRUE;
     }
 
     while (++MARK <= SP) {
         SV * const keysv = *MARK;
         SV **svp;
         HE *he;
-        bool preeminent = FALSE;
-
-        if (localizing) {
-            preeminent = SvRMAGICAL(hv) && !other_magic ? 1 :
-                hv_exists_ent(hv, keysv, 0);
+        bool preeminent = TRUE;
+
+        if (localizing && can_preserve) {
+           /* 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. */
+            preeminent = hv_exists_ent(hv, keysv, 0);
         }
 
         he = hv_fetch_ent(hv, keysv, lval, 0);
@@ -4526,7 +4544,9 @@ PP(pp_push)
        LEAVE;
        SPAGAIN;
        SP = ORIGMARK;
-       PUSHi( AvFILL(ary) + 1 );
+       if (GIMME_V != G_VOID) {
+           PUSHi( AvFILL(ary) + 1 );
+       }
     }
     else {
        PL_delaymagic = DM_DELAY;
@@ -4584,7 +4604,9 @@ PP(pp_unshift)
        }
     }
     SP = ORIGMARK;
-    PUSHi( AvFILL(ary) + 1 );
+    if (GIMME_V != G_VOID) {
+       PUSHi( AvFILL(ary) + 1 );
+    }
     RETURN;
 }
 
@@ -5040,9 +5062,9 @@ PP(pp_lock)
     dSP;
     dTOPss;
     SV *retsv = sv;
+    assert(SvTYPE(retsv) != SVt_PVCV);
     SvLOCK(sv);
-    if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
-       || SvTYPE(retsv) == SVt_PVCV) {
+    if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV) {
        retsv = refto(retsv);
     }
     SETs(retsv);