This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Better document setlocale, "use locale" interactions
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index 71b9ec9..8449047 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -162,17 +162,38 @@ Perl_newGP(pTHX_ GV *const gv)
 {
     GP *gp;
     U32 hash;
 {
     GP *gp;
     U32 hash;
-#ifdef USE_ITHREADS
-    const char *const file
-       = (PL_curcop && CopFILE(PL_curcop)) ? CopFILE(PL_curcop) : "";
-    const STRLEN len = strlen(file);
-#else
-    SV *const temp_sv = CopFILESV(PL_curcop);
     const char *file;
     STRLEN len;
     const char *file;
     STRLEN len;
+#ifndef USE_ITHREADS
+    SV * temp_sv;
+#endif
+    dVAR;
 
     PERL_ARGS_ASSERT_NEWGP;
 
     PERL_ARGS_ASSERT_NEWGP;
+    Newxz(gp, 1, GP);
+    gp->gp_egv = gv; /* allow compiler to reuse gv after this */
+#ifndef PERL_DONT_CREATE_GVSV
+    gp->gp_sv = newSV(0);
+#endif
 
 
+#ifdef USE_ITHREADS
+    if (PL_curcop) {
+       gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */
+       if (CopFILE(PL_curcop)) {
+           file = CopFILE(PL_curcop);
+           len = strlen(file);
+       }
+       else goto no_file;
+    }
+    else {
+       no_file:
+       file = "";
+       len = 0;
+    }
+#else
+    if(PL_curcop)
+       gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */
+    temp_sv = CopFILESV(PL_curcop);
     if (temp_sv) {
        file = SvPVX(temp_sv);
        len = SvCUR(temp_sv);
     if (temp_sv) {
        file = SvPVX(temp_sv);
        len = SvCUR(temp_sv);
@@ -183,18 +204,7 @@ Perl_newGP(pTHX_ GV *const gv)
 #endif
 
     PERL_HASH(hash, file, len);
 #endif
 
     PERL_HASH(hash, file, len);
-
-    Newxz(gp, 1, GP);
-
-#ifndef PERL_DONT_CREATE_GVSV
-    gp->gp_sv = newSV(0);
-#endif
-
-    gp->gp_line = PL_curcop ? CopLINE(PL_curcop) : 0;
-    /* XXX Ideally this cast would be replaced with a change to const char*
-       in the struct.  */
     gp->gp_file_hek = share_hek(file, len, hash);
     gp->gp_file_hek = share_hek(file, len, hash);
-    gp->gp_egv = gv;
     gp->gp_refcnt = 1;
 
     return gp;
     gp->gp_refcnt = 1;
 
     return gp;
@@ -207,6 +217,7 @@ void
 Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
 {
     GV * const oldgv = CvGV(cv);
 Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
 {
     GV * const oldgv = CvGV(cv);
+    HEK *hek;
     PERL_ARGS_ASSERT_CVGV_SET;
 
     if (oldgv == gv)
     PERL_ARGS_ASSERT_CVGV_SET;
 
     if (oldgv == gv)
@@ -214,15 +225,16 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
 
     if (oldgv) {
        if (CvCVGV_RC(cv)) {
 
     if (oldgv) {
        if (CvCVGV_RC(cv)) {
-           SvREFCNT_dec(oldgv);
+           SvREFCNT_dec_NN(oldgv);
            CvCVGV_RC_off(cv);
        }
        else {
            sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv));
        }
     }
            CvCVGV_RC_off(cv);
        }
        else {
            sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv));
        }
     }
+    else if ((hek = CvNAME_HEK(cv))) unshare_hek(hek);
 
 
-    SvANY(cv)->xcv_gv = gv;
+    SvANY(cv)->xcv_gv_u.xcv_gv = gv;
     assert(!CvCVGV_RC(cv));
 
     if (!gv)
     assert(!CvCVGV_RC(cv));
 
     if (!gv)
@@ -438,7 +450,6 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     static const char file[] = __FILE__;
     CV *cv, *oldcompcv = NULL;
     int opnum = 0;
     static const char file[] = __FILE__;
     CV *cv, *oldcompcv = NULL;
     int opnum = 0;
-    SV *opnumsv;
     bool ampable = TRUE; /* &{}-able */
     COP *oldcurcop = NULL;
     yy_parser *oldparser = NULL;
     bool ampable = TRUE; /* &{}-able */
     COP *oldcurcop = NULL;
     yy_parser *oldparser = NULL;
@@ -524,8 +535,13 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     if (stash)
        (void)hv_store(stash,name,len,(SV *)gv,0);
     if (ampable) {
     if (stash)
        (void)hv_store(stash,name,len,(SV *)gv,0);
     if (ampable) {
+#ifdef DEBUGGING
+        CV *orig_cv = cv;
+#endif
        CvLVALUE_on(cv);
        CvLVALUE_on(cv);
-       newATTRSUB_flags(
+        /* newATTRSUB will free the CV and return NULL if we're still
+           compiling after a syntax error */
+       if ((cv = newATTRSUB_flags(
                   oldsavestack_ix, (OP *)gv,
                   NULL,NULL,
                   coresub_op(
                   oldsavestack_ix, (OP *)gv,
                   NULL,NULL,
                   coresub_op(
@@ -535,21 +551,25 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
                     code, opnum
                   ),
                   1
                     code, opnum
                   ),
                   1
-       );
-       assert(GvCV(gv) == cv);
-       if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
-        && opnum != OP_UNDEF)
-           CvLVALUE_off(cv); /* Now *that* was a neat trick. */
+               )) != NULL) {
+            assert(GvCV(gv) == orig_cv);
+            if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
+                && opnum != OP_UNDEF)
+                CvLVALUE_off(cv); /* Now *that* was a neat trick. */
+        }
        LEAVE;
        PL_parser = oldparser;
        PL_curcop = oldcurcop;
        PL_compcv = oldcompcv;
     }
        LEAVE;
        PL_parser = oldparser;
        PL_curcop = oldcurcop;
        PL_compcv = oldcompcv;
     }
-    opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
-    cv_set_call_checker(
-       cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
-    );
-    SvREFCNT_dec(opnumsv);
+    if (cv) {
+        SV *opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
+        cv_set_call_checker(
+          cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
+        );
+        SvREFCNT_dec(opnumsv);
+    }
+
     return gv;
 }
 
     return gv;
 }
 
@@ -606,9 +626,12 @@ side-effect creates a glob with the given C<name> in the given C<stash>
 which in the case of success contains an alias for the subroutine, and sets
 up caching info for this glob.
 
 which in the case of success contains an alias for the subroutine, and sets
 up caching info for this glob.
 
-Currently, the only significant value for C<flags> is SVf_UTF8.
+The only significant values for C<flags> are GV_SUPER and SVf_UTF8.
+
+GV_SUPER indicates that we want to look up the method in the superclasses
+of the C<stash>.
 
 
-This function grants C<"SUPER"> token as a postfix of the stash name. The
+The
 GV returned from C<gv_fetchmeth> may be a method cache entry, which is not
 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
 GV returned from C<gv_fetchmeth> may be a method cache entry, which is not
 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
@@ -627,14 +650,13 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
     AV* linear_av;
     SV** linear_svp;
     SV* linear_sv;
     AV* linear_av;
     SV** linear_svp;
     SV* linear_sv;
-    HV* cstash;
+    HV* cstash, *cachestash;
     GV* candidate = NULL;
     CV* cand_cv = NULL;
     GV* topgv = NULL;
     const char *hvname;
     I32 create = (level >= 0) ? 1 : 0;
     I32 items;
     GV* candidate = NULL;
     CV* cand_cv = NULL;
     GV* topgv = NULL;
     const char *hvname;
     I32 create = (level >= 0) ? 1 : 0;
     I32 items;
-    STRLEN packlen;
     U32 topgen_cmp;
     U32 is_utf8 = flags & SVf_UTF8;
 
     U32 topgen_cmp;
     U32 is_utf8 = flags & SVf_UTF8;
 
@@ -656,12 +678,20 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
     assert(hvname);
     assert(name);
 
     assert(hvname);
     assert(name);
 
-    DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,hvname) );
+    DEBUG_o( Perl_deb(aTHX_ "Looking for %smethod %s in package %s\n",
+                     flags & GV_SUPER ? "SUPER " : "",name,hvname) );
 
     topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
 
 
     topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
 
+    if (flags & GV_SUPER) {
+       if (!HvAUX(stash)->xhv_super) HvAUX(stash)->xhv_super = newHV();
+       cachestash = HvAUX(stash)->xhv_super;
+    }
+    else cachestash = stash;
+
     /* check locally for a real method or a cache entry */
     /* check locally for a real method or a cache entry */
-    gvp = (GV**)hv_fetch(stash, name, is_utf8 ? -(I32)len : (I32)len, create);
+    gvp = (GV**)hv_fetch(cachestash, name, is_utf8 ? -(I32)len : (I32)len,
+                        create);
     if(gvp) {
         topgv = *gvp;
       have_gv:
     if(gvp) {
         topgv = *gvp;
       have_gv:
@@ -675,7 +705,7 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
             }
             else {
                 /* stale cache entry, junk it and move on */
             }
             else {
                 /* stale cache entry, junk it and move on */
-               SvREFCNT_dec(cand_cv);
+               SvREFCNT_dec_NN(cand_cv);
                GvCV_set(topgv, NULL);
                cand_cv = NULL;
                GvCVGEN(topgv) = 0;
                GvCV_set(topgv, NULL);
                cand_cv = NULL;
                GvCVGEN(topgv) = 0;
@@ -685,26 +715,14 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
             /* cache indicates no such method definitively */
             return 0;
         }
             /* cache indicates no such method definitively */
             return 0;
         }
-       else if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4
+       else if (stash == cachestash
+             && len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4
               && strnEQ(hvname, "CORE", 4)
               && S_maybe_add_coresub(aTHX_ NULL,topgv,name,len))
            goto have_gv;
     }
 
               && strnEQ(hvname, "CORE", 4)
               && S_maybe_add_coresub(aTHX_ NULL,topgv,name,len))
            goto have_gv;
     }
 
-    packlen = HvNAMELEN_get(stash);
-    if ((packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER"))
-     || (packlen == 5 && strEQ(hvname, "SUPER"))) {
-        HV* basestash;
-        basestash = packlen == 5
-                    ? PL_defstash
-                    : gv_stashpvn(hvname, packlen - 7,
-                                GV_ADD | (HvNAMEUTF8(stash) ? SVf_UTF8 : 0));
-        linear_av = mro_get_linear_isa(basestash);
-    }
-    else {
-        linear_av = mro_get_linear_isa(stash); /* has ourselves at the top of the list */
-    }
-
+    linear_av = mro_get_linear_isa(stash); /* has ourselves at the top of the list */
     linear_svp = AvARRAY(linear_av) + 1; /* skip over self */
     items = AvFILLp(linear_av); /* no +1, to skip over self */
     while (items--) {
     linear_svp = AvARRAY(linear_av) + 1; /* skip over self */
     items = AvFILLp(linear_av); /* no +1, to skip over self */
     while (items--) {
@@ -758,7 +776,7 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
 
     /* Check UNIVERSAL without caching */
     if(level == 0 || level == -1) {
 
     /* Check UNIVERSAL without caching */
     if(level == 0 || level == -1) {
-        candidate = gv_fetchmeth_pvn(NULL, name, len, 1, flags);
+        candidate = gv_fetchmeth_pvn(NULL, name, len, 1, flags &~GV_SUPER);
         if(candidate) {
             cand_cv = GvCV(candidate);
             if (topgv && (GvREFCNT(topgv) == 1) && (CvROOT(cand_cv) || CvXSUB(cand_cv))) {
         if(candidate) {
             cand_cv = GvCV(candidate);
             if (topgv && (GvREFCNT(topgv) == 1) && (CvROOT(cand_cv) || CvXSUB(cand_cv))) {
@@ -897,35 +915,6 @@ C<call_sv> apply equally to these functions.
 =cut
 */
 
 =cut
 */
 
-STATIC HV*
-S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen, U32 flags)
-{
-    AV* superisa;
-    GV** gvp;
-    GV* gv;
-    HV* stash;
-
-    PERL_ARGS_ASSERT_GV_GET_SUPER_PKG;
-
-    stash = gv_stashpvn(name, namelen, flags);
-    if(stash) return stash;
-
-    /* If we must create it, give it an @ISA array containing
-       the real package this SUPER is for, so that it's tied
-       into the cache invalidation code correctly */
-    stash = gv_stashpvn(name, namelen, GV_ADD | flags);
-    gvp = (GV**)hv_fetchs(stash, "ISA", TRUE);
-    gv = *gvp;
-    gv_init(gv, stash, "ISA", 3, TRUE);
-    superisa = GvAVn(gv);
-    GvMULTI_on(gv);
-    sv_magic(MUTABLE_SV(superisa), MUTABLE_SV(gv), PERL_MAGIC_isa, NULL, 0);
-    av_push(superisa, newSVhek(CopSTASH(PL_curcop)
-                              ? HvNAME_HEK(CopSTASH(PL_curcop)) : NULL));
-
-    return stash;
-}
-
 GV *
 Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 {
 GV *
 Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 {
@@ -992,25 +981,20 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
     if (nsplit) {
        if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
            /* ->SUPER::method should really be looked up in original stash */
     if (nsplit) {
        if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
            /* ->SUPER::method should really be looked up in original stash */
-           SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_
-                    "%"HEKf"::SUPER",
-                     HEKfARG(HvNAME_HEK((HV*)CopSTASH(PL_curcop)))
-           ));
-           /* __PACKAGE__::SUPER stash should be autovivified */
-           stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr), SvUTF8(tmpstr));
+           stash = CopSTASH(PL_curcop);
+           flags |= GV_SUPER;
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
-                        origname, HvNAME_get(stash), name) );
+                        origname, HvENAME_get(stash), name) );
+       }
+       else if ((nsplit - origname) >= 7 &&
+                strnEQ(nsplit - 7, "::SUPER", 7)) {
+            /* don't autovifify if ->NoSuchStash::SUPER::method */
+           stash = gv_stashpvn(origname, nsplit - origname - 7, is_utf8);
+           if (stash) flags |= GV_SUPER;
        }
        else {
             /* don't autovifify if ->NoSuchStash::method */
             stash = gv_stashpvn(origname, nsplit - origname, is_utf8);
        }
        else {
             /* don't autovifify if ->NoSuchStash::method */
             stash = gv_stashpvn(origname, nsplit - origname, is_utf8);
-
-           /* however, explicit calls to Pkg::SUPER::method may
-              happen, and may require autovivification to work */
-           if (!stash && (nsplit - origname) >= 7 &&
-               strnEQ(nsplit - 7, "::SUPER", 7) &&
-               gv_stashpvn(origname, nsplit - origname - 7, is_utf8))
-             stash = gv_get_super_pkg(origname, nsplit - origname, flags);
        }
        ostash = stash;
     }
        }
        ostash = stash;
     }
@@ -1042,10 +1026,9 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                        return gv;
                }
                Perl_croak(aTHX_
                        return gv;
                }
                Perl_croak(aTHX_
-                          "Can't locate object method \"%"SVf
+                          "Can't locate object method \"%"UTF8f
                           "\" via package \"%"HEKf"\"",
                           "\" via package \"%"HEKf"\"",
-                                   SVfARG(newSVpvn_flags(name, nend - name,
-                                           SVs_TEMP | is_utf8)),
+                                   UTF8fARG(is_utf8, nend - name, name),
                                     HEKfARG(HvNAME_HEK(stash)));
            }
            else {
                                     HEKfARG(HvNAME_HEK(stash)));
            }
            else {
@@ -1055,14 +1038,14 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                    packnamesv = newSVpvn_flags(origname, nsplit - origname,
                                                     SVs_TEMP | is_utf8);
                } else {
                    packnamesv = newSVpvn_flags(origname, nsplit - origname,
                                                     SVs_TEMP | is_utf8);
                } else {
-                   packnamesv = sv_2mortal(newSVsv(error_report));
+                   packnamesv = error_report;
                }
 
                Perl_croak(aTHX_
                }
 
                Perl_croak(aTHX_
-                          "Can't locate object method \"%"SVf"\" via package \"%"SVf"\""
+                          "Can't locate object method \"%"UTF8f
+                          "\" via package \"%"SVf"\""
                           " (perhaps you forgot to load \"%"SVf"\"?)",
                           " (perhaps you forgot to load \"%"SVf"\"?)",
-                          SVfARG(newSVpvn_flags(name, nend - name,
-                                SVs_TEMP | is_utf8)),
+                          UTF8fARG(is_utf8, nend - name, name),
                            SVfARG(packnamesv), SVfARG(packnamesv));
            }
        }
                            SVfARG(packnamesv), SVfARG(packnamesv));
            }
        }
@@ -1137,6 +1120,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
        }
        else
            packname = sv_2mortal(newSVhek(HvNAME_HEK(stash)));
        }
        else
            packname = sv_2mortal(newSVhek(HvNAME_HEK(stash)));
+       if (flags & GV_SUPER) sv_catpvs(packname, "::SUPER");
     }
     if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, is_utf8)))
        return NULL;
     }
     if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, is_utf8)))
        return NULL;
@@ -1153,9 +1137,10 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
      && (GvCVGEN(gv) || GvSTASH(gv) != stash)
     )
        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
      && (GvCVGEN(gv) || GvSTASH(gv) != stash)
     )
        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                        "Use of inherited AUTOLOAD for non-method %"SVf"::%"SVf"() is deprecated",
+                        "Use of inherited AUTOLOAD for non-method %"SVf
+                        "::%"UTF8f"() is deprecated",
                         SVfARG(packname),
                         SVfARG(packname),
-                         SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8)));
+                         UTF8fARG(is_utf8, len, name));
 
     if (CvISXSUB(cv)) {
         /* Instead of forcing the XSUB do another lookup for $AUTOLOAD
 
     if (CvISXSUB(cv)) {
         /* Instead of forcing the XSUB do another lookup for $AUTOLOAD
@@ -1182,7 +1167,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
          */
        CvSTASH_set(cv, stash);
        if (SvPOK(cv)) { /* Ouch! */
          */
        CvSTASH_set(cv, stash);
        if (SvPOK(cv)) { /* Ouch! */
-           SV *tmpsv = newSVpvn_flags(name, len, is_utf8);
+           SV * const tmpsv = newSVpvn_flags(name, len, is_utf8);
            STRLEN ulen;
            const char *proto = CvPROTO(cv);
            assert(proto);
            STRLEN ulen;
            const char *proto = CvPROTO(cv);
            assert(proto);
@@ -1196,7 +1181,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
            SvTEMP_on(tmpsv); /* Allow theft */
            sv_setsv_nomg((SV *)cv, tmpsv);
            SvTEMP_off(tmpsv);
            SvTEMP_on(tmpsv); /* Allow theft */
            sv_setsv_nomg((SV *)cv, tmpsv);
            SvTEMP_off(tmpsv);
-           SvREFCNT_dec(tmpsv);
+           SvREFCNT_dec_NN(tmpsv);
            SvLEN(cv) = SvCUR(cv) + 1;
            SvCUR(cv) = ulen;
        }
            SvLEN(cv) = SvCUR(cv) + 1;
            SvCUR(cv) = ulen;
        }
@@ -1272,13 +1257,12 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp
        const char type = varname == '[' ? '$' : '%';
        dSP;
        ENTER;
        const char type = varname == '[' ? '$' : '%';
        dSP;
        ENTER;
+       SAVEFREESV(namesv);
        if ( flags & 1 )
            save_scalar(gv);
        PUSHSTACKi(PERLSI_MAGIC);
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
        POPSTACK;
        if ( flags & 1 )
            save_scalar(gv);
        PUSHSTACKi(PERLSI_MAGIC);
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
        POPSTACK;
-       LEAVE;
-       SPAGAIN;
        stash = gv_stashsv(namesv, 0);
        if (!stash)
            Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" is not available",
        stash = gv_stashsv(namesv, 0);
        if (!stash)
            Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" is not available",
@@ -1286,8 +1270,9 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp
        else if (!gv_fetchmethod(stash, methpv))
            Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" does not support method %s",
                    type, varname, SVfARG(namesv), methpv);
        else if (!gv_fetchmethod(stash, methpv))
            Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" does not support method %s",
                    type, varname, SVfARG(namesv), methpv);
+       LEAVE;
     }
     }
-    SvREFCNT_dec(namesv);
+    else SvREFCNT_dec_NN(namesv);
     return stash;
 }
 
     return stash;
 }
 
@@ -1425,7 +1410,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     const char *name = nambeg;
     GV *gv = NULL;
     GV**gvp;
     const char *name = nambeg;
     GV *gv = NULL;
     GV**gvp;
-    I32 len;
+    STRLEN len;
     const char *name_cursor;
     HV *stash = NULL;
     const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
     const char *name_cursor;
     HV *stash = NULL;
     const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
@@ -1523,7 +1508,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 
     if (!stash) {
     no_stash:
 
     if (!stash) {
     no_stash:
-       if (len && isIDFIRST_lazy(name)) {
+       if (len && isIDFIRST_lazy_if(name, is_utf8)) {
            bool global = FALSE;
 
            switch (len) {
            bool global = FALSE;
 
            switch (len) {
@@ -1584,18 +1569,18 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                             (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) ||
                             (sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) )
                    {
                             (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) ||
                             (sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) )
                    {
-                        SV* namesv = newSVpvn_flags(name, len, SVs_TEMP | is_utf8);
                        /* diag_listed_as: Variable "%s" is not imported%s */
                        Perl_ck_warner_d(
                            aTHX_ packWARN(WARN_MISC),
                        /* diag_listed_as: Variable "%s" is not imported%s */
                        Perl_ck_warner_d(
                            aTHX_ packWARN(WARN_MISC),
-                           "Variable \"%c%"SVf"\" is not imported",
+                           "Variable \"%c%"UTF8f"\" is not imported",
                            sv_type == SVt_PVAV ? '@' :
                            sv_type == SVt_PVHV ? '%' : '$',
                            sv_type == SVt_PVAV ? '@' :
                            sv_type == SVt_PVHV ? '%' : '$',
-                           SVfARG(namesv));
+                           UTF8fARG(is_utf8, len, name));
                        if (GvCVu(*gvp))
                            Perl_ck_warner_d(
                                aTHX_ packWARN(WARN_MISC),
                        if (GvCVu(*gvp))
                            Perl_ck_warner_d(
                                aTHX_ packWARN(WARN_MISC),
-                               "\t(Did you mean &%"SVf" instead?)\n", SVfARG(namesv)
+                               "\t(Did you mean &%"UTF8f" instead?)\n",
+                               UTF8fARG(is_utf8, len, name)
                            );
                        stash = NULL;
                    }
                            );
                        stash = NULL;
                    }
@@ -1611,15 +1596,16 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     /* By this point we should have a stash and a name */
 
     if (!stash) {
     /* By this point we should have a stash and a name */
 
     if (!stash) {
-       if (add) {
+       if (add && !PL_in_clean_all) {
            SV * const err = Perl_mess(aTHX_
            SV * const err = Perl_mess(aTHX_
-                "Global symbol \"%s%"SVf"\" requires explicit package name",
+                "Global symbol \"%s%"UTF8f
+                "\" requires explicit package name",
                 (sv_type == SVt_PV ? "$"
                  : sv_type == SVt_PVAV ? "@"
                  : sv_type == SVt_PVHV ? "%"
                 (sv_type == SVt_PV ? "$"
                  : sv_type == SVt_PVAV ? "@"
                  : sv_type == SVt_PVHV ? "%"
-                 : ""), SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8)));
+                 : ""), UTF8fARG(is_utf8, len, name));
            GV *gv;
            GV *gv;
-           if (USE_UTF8_IN_NAMES)
+           if (is_utf8)
                SvUTF8_on(err);
            qerror(err);
            gv = gv_fetchpvs("<none>::", GV_ADDMULTI, SVt_PVHV);
                SvUTF8_on(err);
            qerror(err);
            gv = gv_fetchpvs("<none>::", GV_ADDMULTI, SVt_PVHV);
@@ -1649,18 +1635,30 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        if (add) {
            GvMULTI_on(gv);
            gv_init_svtype(gv, sv_type);
        if (add) {
            GvMULTI_on(gv);
            gv_init_svtype(gv, sv_type);
+            /* You reach this path once the typeglob has already been created,
+               either by the same or a different sigil.  If this path didn't
+               exist, then (say) referencing $! first, and %! second would
+               mean that %! was not handled correctly.  */
            if (len == 1 && stash == PL_defstash) {
              if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) {
                if (*name == '!')
                    require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
                else if (*name == '-' || *name == '+')
                    require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
            if (len == 1 && stash == PL_defstash) {
              if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) {
                if (*name == '!')
                    require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
                else if (*name == '-' || *name == '+')
                    require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
-             }
+              } else if (sv_type == SVt_PV) {
+                  if (*name == '*' || *name == '#') {
+                      /* diag_listed_as: $* is no longer supported */
+                      Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
+                                                       WARN_SYNTAX),
+                                       "$%c is no longer supported", *name);
+                  }
+              }
              if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
                 switch (*name) {
                case '[':
                    require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
                     break;
              if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
                 switch (*name) {
                case '[':
                    require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
                     break;
+#ifdef PERL_SAWAMPERSAND
                case '`':
                    PL_sawampersand |= SAWAMPERSAND_LEFT;
                     (void)GvSVn(gv);
                case '`':
                    PL_sawampersand |= SAWAMPERSAND_LEFT;
                     (void)GvSVn(gv);
@@ -1673,6 +1671,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    PL_sawampersand |= SAWAMPERSAND_RIGHT;
                     (void)GvSVn(gv);
                     break;
                    PL_sawampersand |= SAWAMPERSAND_RIGHT;
                     (void)GvSVn(gv);
                     break;
+#endif
                 }
              }
            }
                 }
              }
            }
@@ -1700,8 +1699,9 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     faking_it = SvOK(gv);
 
     if (add & GV_ADDWARN)
     faking_it = SvOK(gv);
 
     if (add & GV_ADDWARN)
-       Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %"SVf" unexpectedly",
-                SVfARG(newSVpvn_flags(nambeg, name_end-nambeg, SVs_TEMP | is_utf8 )));
+       Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+               "Had to create %"UTF8f" unexpectedly",
+                UTF8fARG(is_utf8, name_end-nambeg, nambeg));
     gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8);
 
     if ( isIDFIRST_lazy_if(name, is_utf8)
     gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8);
 
     if ( isIDFIRST_lazy_if(name, is_utf8)
@@ -1818,6 +1818,10 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                if (strEQ(name2, "LOBAL_PHASE"))
                    goto ro_magicalize;
                break;
                if (strEQ(name2, "LOBAL_PHASE"))
                    goto ro_magicalize;
                break;
+           case '\014':        /* $^LAST_FH */
+               if (strEQ(name2, "AST_FH"))
+                   goto ro_magicalize;
+               break;
             case '\015':        /* $^MATCH */
                 if (strEQ(name2, "ATCH"))
                    goto magicalize;
             case '\015':        /* $^MATCH */
                 if (strEQ(name2, "ATCH"))
                    goto magicalize;
@@ -1873,6 +1877,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        case '&':               /* $& */
        case '`':               /* $` */
        case '\'':              /* $' */
        case '&':               /* $& */
        case '`':               /* $` */
        case '\'':              /* $' */
+#ifdef PERL_SAWAMPERSAND
            if (!(
                sv_type == SVt_PVAV ||
                sv_type == SVt_PVHV ||
            if (!(
                sv_type == SVt_PVAV ||
                sv_type == SVt_PVHV ||
@@ -1886,6 +1891,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                                 ? SAWAMPERSAND_MIDDLE
                                 : SAWAMPERSAND_RIGHT;
                 }
                                 ? SAWAMPERSAND_MIDDLE
                                 : SAWAMPERSAND_RIGHT;
                 }
+#endif
            goto magicalize;
 
        case ':':               /* $: */
            goto magicalize;
 
        case ':':               /* $: */
@@ -1942,10 +1948,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
                                 "$%c is no longer supported", *name);
            break;
                Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
                                 "$%c is no longer supported", *name);
            break;
-       case '|':               /* $| */
-           sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
-           goto magicalize;
-
        case '\010':    /* $^H */
            {
                HV *const hv = GvHVn(gv);
        case '\010':    /* $^H */
            {
                HV *const hv = GvHVn(gv);
@@ -1986,6 +1988,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        case '>':               /* $> */
        case '\\':              /* $\ */
        case '/':               /* $/ */
        case '>':               /* $> */
        case '\\':              /* $\ */
        case '/':               /* $/ */
+       case '|':               /* $| */
        case '$':               /* $$ */
        case '\001':    /* $^A */
        case '\003':    /* $^C */
        case '$':               /* $$ */
        case '\001':    /* $^A */
        case '\003':    /* $^C */
@@ -2004,7 +2007,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 
        case '\014':    /* $^L */
            sv_setpvs(GvSVn(gv),"\f");
 
        case '\014':    /* $^L */
            sv_setpvs(GvSVn(gv),"\f");
-           PL_formfeed = GvSV(gv);
            break;
        case ';':               /* $; */
            sv_setpvs(GvSVn(gv),"\034");
            break;
        case ';':               /* $; */
            sv_setpvs(GvSVn(gv),"\034");
@@ -2035,7 +2037,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
             GvSV(gv) && (SvOK(GvSV(gv)) || SvMAGICAL(GvSV(gv)))
           ))
            (void)hv_store(stash,name,len,(SV *)gv,0);
             GvSV(gv) && (SvOK(GvSV(gv)) || SvMAGICAL(GvSV(gv)))
           ))
            (void)hv_store(stash,name,len,(SV *)gv,0);
-       else SvREFCNT_dec(gv), gv = NULL;
+       else SvREFCNT_dec_NN(gv), gv = NULL;
     }
     if (gv) gv_init_svtype(gv, faking_it ? SVt_PVCV : sv_type);
     return gv;
     }
     if (gv) gv_init_svtype(gv, faking_it ? SVt_PVCV : sv_type);
     return gv;
@@ -2122,10 +2124,10 @@ Perl_newGVgen_flags(pTHX_ const char *pack, U32 flags)
 {
     dVAR;
     PERL_ARGS_ASSERT_NEWGVGEN_FLAGS;
 {
     dVAR;
     PERL_ARGS_ASSERT_NEWGVGEN_FLAGS;
+    assert(!(flags & ~SVf_UTF8));
 
 
-    return gv_fetchpv(Perl_form(aTHX_ "%"SVf"::_GEN_%ld",
-                                    SVfARG(newSVpvn_flags(pack, strlen(pack),
-                                            SVs_TEMP | flags)),
+    return gv_fetchpv(Perl_form(aTHX_ "%"UTF8f"::_GEN_%ld",
+                                UTF8fARG(flags, strlen(pack), pack),
                                 (long)PL_gensym++),
                       GV_ADD, SVt_PVGV);
 }
                                 (long)PL_gensym++),
                       GV_ADD, SVt_PVGV);
 }
@@ -2144,7 +2146,7 @@ Perl_gp_ref(pTHX_ GP *gp)
            /* If the GP they asked for a reference to contains
                a method cache entry, clear it first, so that we
                don't infect them with our cached entry */
            /* If the GP they asked for a reference to contains
                a method cache entry, clear it first, so that we
                don't infect them with our cached entry */
-           SvREFCNT_dec(gp->gp_cv);
+           SvREFCNT_dec_NN(gp->gp_cv);
            gp->gp_cv = NULL;
            gp->gp_cvgen = 0;
        }
            gp->gp_cv = NULL;
            gp->gp_cvgen = 0;
        }
@@ -2202,6 +2204,7 @@ Perl_gp_free(pTHX_ GV *gv)
          Somehow gp->gp_hv can end up pointing at freed garbage.  */
       if (hv && SvTYPE(hv) == SVt_PVHV) {
         const HEK *hvname_hek = HvNAME_HEK(hv);
          Somehow gp->gp_hv can end up pointing at freed garbage.  */
       if (hv && SvTYPE(hv) == SVt_PVHV) {
         const HEK *hvname_hek = HvNAME_HEK(hv);
+        DEBUG_o(Perl_deb(aTHX_ "gp_free clearing PL_stashcache for '%"HEKf"'\n", hvname_hek));
         if (PL_stashcache && hvname_hek)
            (void)hv_delete(PL_stashcache, HEK_KEY(hvname_hek),
                       (HEK_UTF8(hvname_hek) ? -HEK_LEN(hvname_hek) : HEK_LEN(hvname_hek)),
         if (PL_stashcache && hvname_hek)
            (void)hv_delete(PL_stashcache, HEK_KEY(hvname_hek),
                       (HEK_UTF8(hvname_hek) ? -HEK_LEN(hvname_hek) : HEK_LEN(hvname_hek)),
@@ -2245,7 +2248,7 @@ Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
        for (i = 1; i < NofAMmeth; i++) {
            CV * const cv = amtp->table[i];
            if (cv) {
        for (i = 1; i < NofAMmeth; i++) {
            CV * const cv = amtp->table[i];
            if (cv) {
-               SvREFCNT_dec(MUTABLE_SV(cv));
+               SvREFCNT_dec_NN(MUTABLE_SV(cv));
                amtp->table[i] = NULL;
            }
        }
                amtp->table[i] = NULL;
            }
        }
@@ -2275,7 +2278,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
   if (mg) {
       const AMT * const amtp = (AMT*)mg->mg_ptr;
       if (amtp->was_ok_sub == newgen) {
   if (mg) {
       const AMT * const amtp = (AMT*)mg->mg_ptr;
       if (amtp->was_ok_sub == newgen) {
-         return AMT_OVERLOADED(amtp) ? 1 : 0;
+         return AMT_AMAGIC(amtp) ? 1 : 0;
       }
       sv_unmagic(MUTABLE_SV(stash), PERL_MAGIC_overload_table);
   }
       }
       sv_unmagic(MUTABLE_SV(stash), PERL_MAGIC_overload_table);
   }
@@ -2288,8 +2291,8 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
   amt.flags = 0;
 
   {
   amt.flags = 0;
 
   {
-    int filled = 0, have_ovl = 0;
-    int i, lim = 1;
+    int filled = 0;
+    int i;
 
     /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
 
     /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
@@ -2301,7 +2304,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
     if (!gv)
     {
       if (!gv_fetchmeth_pvn(stash, "((", 2, -1, 0))
     if (!gv)
     {
       if (!gv_fetchmeth_pvn(stash, "((", 2, -1, 0))
-       lim = DESTROY_amg;              /* Skip overloading entries. */
+       goto no_table;
     }
 #ifdef PERL_DONT_CREATE_GVSV
     else if (!sv) {
     }
 #ifdef PERL_DONT_CREATE_GVSV
     else if (!sv) {
@@ -2315,19 +2318,15 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
     else if (SvOK(sv)) {
        amt.fallback=AMGfallNEVER;
         filled = 1;
     else if (SvOK(sv)) {
        amt.fallback=AMGfallNEVER;
         filled = 1;
-        have_ovl = 1;
     }
     else {
         filled = 1;
     }
     else {
         filled = 1;
-        have_ovl = 1;
     }
 
     }
 
-    for (i = 1; i < lim; i++)
-       amt.table[i] = NULL;
-    for (; i < NofAMmeth; i++) {
+    for (i = 1; i < NofAMmeth; i++) {
        const char * const cooky = PL_AMG_names[i];
        /* Human-readable form, for debugging: */
        const char * const cooky = PL_AMG_names[i];
        /* Human-readable form, for debugging: */
-       const char * const cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
+       const char * const cp = AMG_id2name(i);
        const STRLEN l = PL_AMG_namelens[i];
 
        DEBUG_o( Perl_deb(aTHX_ "Checking overloading of \"%s\" in package \"%.256s\"\n",
        const STRLEN l = PL_AMG_namelens[i];
 
        DEBUG_o( Perl_deb(aTHX_ "Checking overloading of \"%s\" in package \"%.256s\"\n",
@@ -2339,10 +2338,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
           then we could have created stubs for "(+0" in A and C too.
           But if B overloads "bool", we may want to use it for
           numifying instead of C's "+0". */
           then we could have created stubs for "(+0" in A and C too.
           But if B overloads "bool", we may want to use it for
           numifying instead of C's "+0". */
-       if (i >= DESTROY_amg)
-           gv = Perl_gv_fetchmeth_pvn_autoload(aTHX_ stash, cooky, l, 0, 0);
-       else                            /* Autoload taken care of below */
-           gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0);
+       gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0);
         cv = 0;
         if (gv && (cv = GvCV(gv))) {
            if(GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")){
         cv = 0;
         if (gv && (cv = GvCV(gv))) {
            if(GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")){
@@ -2388,8 +2384,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
                         cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))),
                         GvNAME(CvGV(cv))) );
            filled = 1;
                         cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))),
                         GvNAME(CvGV(cv))) );
            filled = 1;
-           if (i < DESTROY_amg)
-               have_ovl = 1;
        } else if (gv) {                /* Autoloaded... */
            cv = MUTABLE_CV(gv);
            filled = 1;
        } else if (gv) {                /* Autoloaded... */
            cv = MUTABLE_CV(gv);
            filled = 1;
@@ -2398,15 +2392,13 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
     }
     if (filled) {
       AMT_AMAGIC_on(&amt);
     }
     if (filled) {
       AMT_AMAGIC_on(&amt);
-      if (have_ovl)
-         AMT_OVERLOADED_on(&amt);
       sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table,
                                                (char*)&amt, sizeof(AMT));
       sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table,
                                                (char*)&amt, sizeof(AMT));
-      return have_ovl;
+      return TRUE;
     }
   }
   /* Here we have no table: */
     }
   }
   /* Here we have no table: */
-  /* no_table: */
+ no_table:
   AMT_AMAGIC_off(&amt);
   sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table,
                                                (char*)&amt, sizeof(AMTS));
   AMT_AMAGIC_off(&amt);
   sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table,
                                                (char*)&amt, sizeof(AMTS));
@@ -2432,19 +2424,8 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
     mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table);
     if (!mg) {
       do_update:
     mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table);
     if (!mg) {
       do_update:
-       /* If we're looking up a destructor to invoke, we must avoid
-        * that Gv_AMupdate croaks, because we might be dying already */
-       if (Gv_AMupdate(stash, cBOOL(id == DESTROY_amg)) == -1) {
-           /* and if it didn't found a destructor, we fall back
-            * to a simpler method that will only look for the
-            * destructor instead of the whole magic */
-           if (id == DESTROY_amg) {
-               GV * const gv = gv_fetchmethod(stash, "DESTROY");
-               if (gv)
-                   return GvCV(gv);
-           }
+       if (Gv_AMupdate(stash, 0) == -1)
            return NULL;
            return NULL;
-       }
        mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table);
     }
     assert(mg);
        mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table);
     }
     assert(mg);
@@ -2774,16 +2755,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
               && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                          ? (amtp = (AMT*)mg->mg_ptr)->table
                          : NULL))
               && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                          ? (amtp = (AMT*)mg->mg_ptr)->table
                          : NULL))
-              && ((cv = cvp[off=method+assignshift])
-                  || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
-                                                                  * usual method */
-                      (
-#ifdef DEBUGGING
-                       fl = 1,
-#endif
-                       cv = cvp[off=method])))) { /* Method for right
-                                                   * argument found */
-       lr=1;
+              && (cv = cvp[off=method])) { /* Method for right
+                                            * argument found */
+      lr=1;
     } else if (((cvp && amtp->fallback > AMGfallNEVER)
                 || (ocvp && oamtp->fallback > AMGfallNEVER))
               && !(flags & AMGf_unary)) {
     } else if (((cvp && amtp->fallback > AMGfallNEVER)
                 || (ocvp && oamtp->fallback > AMGfallNEVER))
               && !(flags & AMGf_unary)) {
@@ -2988,7 +2962,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       if (SvREFCNT(tmpRef) > 1 && (rv_copy = AMG_CALLunary(left,copy_amg))) {
          SvRV_set(left, rv_copy);
          SvSETMAGIC(left);
       if (SvREFCNT(tmpRef) > 1 && (rv_copy = AMG_CALLunary(left,copy_amg))) {
          SvRV_set(left, rv_copy);
          SvSETMAGIC(left);
-         SvREFCNT_dec(tmpRef);  
+         SvREFCNT_dec_NN(tmpRef);  
       }
   }
 
       }
   }
 
@@ -3200,10 +3174,11 @@ Perl_gv_try_downgrade(pTHX_ GV *gv)
                        HEK_LEN(namehek)*(HEK_UTF8(namehek) ? -1 : 1), 0)) &&
            *gvp == (SV*)gv) {
        SV *value = SvREFCNT_inc(CvXSUBANY(cv).any_ptr);
                        HEK_LEN(namehek)*(HEK_UTF8(namehek) ? -1 : 1), 0)) &&
            *gvp == (SV*)gv) {
        SV *value = SvREFCNT_inc(CvXSUBANY(cv).any_ptr);
+       const bool imported = !!GvIMPORTED_CV(gv);
        SvREFCNT(gv) = 0;
        sv_clear((SV*)gv);
        SvREFCNT(gv) = 1;
        SvREFCNT(gv) = 0;
        sv_clear((SV*)gv);
        SvREFCNT(gv) = 1;
-       SvFLAGS(gv) = SVt_IV|SVf_ROK;
+       SvFLAGS(gv) = SVt_IV|SVf_ROK|SVprv_PCS_IMPORTED * imported;
        SvANY(gv) = (XPVGV*)((char*)&(gv->sv_u.svu_iv) -
                                STRUCT_OFFSET(XPVIV, xiv_iv));
        SvRV_set(gv, value);
        SvANY(gv) = (XPVGV*)((char*)&(gv->sv_u.svu_iv) -
                                STRUCT_OFFSET(XPVIV, xiv_iv));
        SvRV_set(gv, value);
Unnamed repository; edit this file 'description' to name the repository.