perldelta for removing experimental status

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index f7ffbfa..3cb182e 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -693,6 +693,8 @@ visible to Perl code.  So when calling C<call_sv>, you should not use
 the GV directly; instead, you should use the method's CV, which can be
 obtained from the GV with the C<GvCV> macro.
 
+=for apidoc Amnh||GV_SUPER
+
 =cut
 */
 
@@ -1266,7 +1268,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
            if (SvUTF8(cv))
                sv_utf8_upgrade_flags_grow(tmpsv, 0, CvPROTOLEN(cv) + 2);
            ulen = SvCUR(tmpsv);
-           SvCUR(tmpsv)++; /* include null in string */
+           SvCUR_set(tmpsv, SvCUR(tmpsv) + 1); /* include null in string */
            sv_catpvn_flags(
                tmpsv, proto, CvPROTOLEN(cv), SV_CATBYTES*!SvUTF8(cv)
            );
@@ -1275,7 +1277,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
            SvTEMP_off(tmpsv);
            SvREFCNT_dec_NN(tmpsv);
            SvLEN_set(cv, SvCUR(cv) + 1);
-           SvCUR(cv) = ulen;
+           SvCUR_set(cv, ulen);
        }
        else {
          sv_setpvn((SV *)cv, name, len);
@@ -1436,6 +1438,8 @@ The most important of which are probably C<GV_ADD> and C<SVf_UTF8>.
 Note, use of C<gv_stashsv> instead of C<gv_stashpvn> where possible is strongly
 recommended for performance reasons.
 
+=for apidoc Amnh||GV_ADD
+
 =cut
 */
 
@@ -1636,7 +1640,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 +1669,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 +1710,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)
@@ -2028,19 +2036,21 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                     sv_magic(MUTABLE_SV(av), (SV*)n, PERL_MAGIC_regdata, NULL, 0);
                     SvREADONLY_on(av);
 
-                    if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-                        require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
+                    require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
 
                 } else          /* %{^CAPTURE_ALL} */
                 if (memEQs(name, len, "\003APTURE_ALL")) {
-                    if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-                        require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
+                    require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
                 }
                break;
            case '\005':        /* $^ENCODING */
                 if (memEQs(name, len, "\005NCODING"))
                    goto magicalize;
                break;
+            case '\006':
+                if (memEQs(name, len, "\006EATURE_BITS"))
+                   goto magicalize;
+                break;
            case '\007':        /* $^GLOBAL_PHASE */
                 if (memEQs(name, len, "\007LOBAL_PHASE"))
                    goto ro_magicalize;
@@ -2938,8 +2948,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 +2963,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 +2992,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.
 */
@@ -3006,24 +3015,30 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
                    (mutator ? AMGf_assign: 0)
                  | (flags & AMGf_numarg));
        if (tmpsv) {
-           if (flags & AMGf_set) {
-               (void)POPs;
-               SETs(tmpsv);
-           }
-           else {
-               dATARGET;
-               (void)POPs;
-               if (mutator || 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;