This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Check off 5.29.10
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index 798c3ae..3b8759e 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1636,7 +1636,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
             if (!*stash)
                 *stash = PL_defstash;
             if (!*stash || !SvREFCNT(*stash)) /* symbol table under destruction */
-                return FALSE;
+                goto notok;
 
             *len = name_cursor - *name;
             if (name_cursor > nambeg) { /* Skip for initial :: or ' */
@@ -1665,8 +1665,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                 gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
                 *gv = gvp ? *gvp : NULL;
                 if (!*gv || *gv == (const GV *)&PL_sv_undef) {
-                    Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
-                    return FALSE;
+                    goto notok;
                 }
                 /* here we know that *gv && *gv != &PL_sv_undef */
                 if (SvTYPE(*gv) != SVt_PVGV)
@@ -1707,15 +1706,20 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                            MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
                    }
                }
-                Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
-                return TRUE;
+                goto ok;
             }
         }
     }
     *len = name_cursor - *name;
+  ok:
+    Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
     return TRUE;
+  notok:
+    Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
+    return FALSE;
 }
 
+
 /* Checks if an unqualified name is in the main stash */
 PERL_STATIC_INLINE bool
 S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8)
@@ -2938,8 +2942,6 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
 /* Implement tryAMAGICun_MG macro.
    Do get magic, then see if the stack arg is overloaded and if so call it.
    Flags:
-       AMGf_set     return the arg using SETs rather than assigning to
-                    the targ
        AMGf_numeric apply sv_2num to the stack arg.
 */
 
@@ -2955,18 +2957,21 @@ Perl_try_amagic_un(pTHX_ int method, int flags) {
                                              AMGf_noright | AMGf_unary
                                            | (flags & AMGf_numarg))))
     {
-       if (flags & AMGf_set) {
-           SETs(tmpsv);
-       }
-       else {
-           dTARGET;
-           if (SvPADMY(TARG)) {
-               sv_setsv(TARG, tmpsv);
-               SETTARG;
-           }
-           else
-               SETs(tmpsv);
-       }
+        /* where the op is of the form:
+         *    $lex = $x op $y (where the assign is optimised away)
+         * then assign the returned value to targ and return that;
+         * otherwise return the value directly
+         */
+        if (   (PL_opargs[PL_op->op_type] & OA_TARGLEX)
+            && (PL_op->op_private & OPpTARGET_MY))
+        {
+            dTARGET;
+            sv_setsv(TARG, tmpsv);
+            SETTARG;
+        }
+        else
+            SETs(tmpsv);
+
        PUTBACK;
        return TRUE;
     }
@@ -2981,8 +2986,6 @@ Perl_try_amagic_un(pTHX_ int method, int flags) {
    Do get magic, then see if the two stack args are overloaded and if so
    call it.
    Flags:
-       AMGf_set     return the arg using SETs rather than assigning to
-                    the targ
        AMGf_assign  op may be called as mutator (eg +=)
        AMGf_numeric apply sv_2num to the stack arg.
 */
@@ -2998,28 +3001,38 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
        SvGETMAGIC(right);
 
     if (SvAMAGIC(left) || SvAMAGIC(right)) {
-       SV * const tmpsv = amagic_call(left, right, method,
-                   ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0)
+       SV * tmpsv;
+        /* STACKED implies mutator variant, e.g. $x += 1 */
+        bool mutator = (flags & AMGf_assign) && (PL_op->op_flags & OPf_STACKED);
+
+       tmpsv = amagic_call(left, right, method,
+                   (mutator ? AMGf_assign: 0)
                  | (flags & AMGf_numarg));
        if (tmpsv) {
-           if (flags & AMGf_set) {
-               (void)POPs;
-               SETs(tmpsv);
-           }
-           else {
-               dATARGET;
-               (void)POPs;
-               if (opASSIGN || SvPADMY(TARG)) {
-                   sv_setsv(TARG, tmpsv);
-                   SETTARG;
-               }
-               else
-                   SETs(tmpsv);
-           }
+            (void)POPs;
+            /* where the op is one of the two forms:
+             *    $x op= $y
+             *    $lex = $x op $y (where the assign is optimised away)
+             * then assign the returned value to targ and return that;
+             * otherwise return the value directly
+             */
+            if (   mutator
+                || (   (PL_opargs[PL_op->op_type] & OA_TARGLEX)
+                    && (PL_op->op_private & OPpTARGET_MY)))
+            {
+                dTARG;
+                TARG = mutator ? *SP : PAD_SV(PL_op->op_targ);
+                sv_setsv(TARG, tmpsv);
+                SETTARG;
+            }
+            else
+                SETs(tmpsv);
+
            PUTBACK;
            return TRUE;
        }
     }
+
     if(left==right && SvGMAGICAL(left)) {
        SV * const left = sv_newmortal();
        *(sp-1) = left;