Lexical stubs should not AUTOLOAD

There is a feature that allows stubs to fall back to their GVs’
CVs when called.  If I reference a stub, e.g., \&bar, and then
bar is autoloaded, the AUTOLOAD sub assigning *bar = *foo or
*bar = sub {...}, I can still call the stub to which I have a refer-
ence, and it will fall back to the overloaded sub.

That is all fine and dandy, but it causes any stub that references a
GV via its CvGV pointer to call that GV’s CV.  If we name a lexical
sub by pointing its CvGV pointer at the GV whose name we want it to
have, then the lexical sub, if undefined, will try to fall back to an
autoloaded sub.

That causes things to gang agley in cases like this:

    use 5.01;
    sub foo { } # package sub
    state sub foo;
    foo(); # calls lexical sub; falls back to package sub

While we could fix this by flagging the sub and checking for the flag
in pp_entersub (as we do with anonymous subs), it is better simply to
use a HEK, instead of a GV.  Since a GV is quite heavyweight for stor-
ing just a name, I was going to do that anyway, eventually.  Doing it
now fixes a bug.

1 files changed, 18 insertions, 18 deletions

diff --git a/op.c b/op.c
index 521c8ad5ed..0272f3342c 100644
--- a/op.c
+++ b/op.c
@@ -6726,6 +6726,9 @@ Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p,
 	{
 	  if (isGV(gv))
 	    gv_efullname3(name = sv_newmortal(), gv, NULL);
+	  else if (SvPOK(gv) && *SvPVX((SV *)gv) == '&')
+	    name = newSVpvn_flags(SvPVX((SV *)gv)+1, SvCUR(gv)-1,
+				  SvUTF8(gv)|SVs_TEMP);
 	  else name = (SV *)gv;
 	}
 	sv_setpvs(msg, "Prototype mismatch:");
@@ -6860,7 +6863,6 @@ CV *
 Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
     dVAR;
-    GV *gv;
     CV **spot;
     SV **svspot;
     const char *ps;
@@ -6870,14 +6872,6 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     register CV *compcv = PL_compcv;
     SV *const_sv;
     const bool ec = PL_parser && PL_parser->error_count;
-
-    /* If the subroutine has no body, no attributes, and no builtin attributes
-       then it's just a sub declaration, and we may be able to get away with
-       storing with a placeholder scalar in the symbol table, rather than a
-       full CV.  If anything is present then it will take a full CV to
-       store it.  */
-    const I32 gv_fetch_flags
-	= ec ? GV_NOADD_NOINIT : GV_ADD;
     PADNAME *name;
 
     PERL_ARGS_ASSERT_NEWMYSUB;
@@ -6901,9 +6895,6 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     else
 	ps = NULL;
 
-    gv = gv_fetchpvn_flags(PadnamePV(name)+1, PadnameLEN(name)-1,
-			   PadnameUTF8(name)|gv_fetch_flags, SVt_PVCV);
-
     if (!PL_madskills) {
 	if (o)
 	    SAVEFREEOP(o);
@@ -6962,7 +6953,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
          * skipping the prototype check
          */
         if (exists || SvPOK(cv))
-            cv_ckproto_len_flags(cv, gv, ps, ps_len, ps_utf8);
+            cv_ckproto_len_flags(cv, (GV *)namesv, ps, ps_len, ps_utf8);
 	/* already defined? */
 	if (exists) {
 	    if ((!block
@@ -7041,12 +7032,12 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    OP * const cvstart = CvSTART(cv);
 
 	    assert(CvWEAKOUTSIDE(cv));
-	    assert(CvCVGV_RC(cv));
-	    assert(CvGV(cv) == gv);
+	    assert(CvNAMED(cv));
+	    assert(CvNAME_HEK(cv));
 
 	    SvPOK_off(cv);
 	    CvFLAGS(cv) =
-		CvFLAGS(compcv) | existing_builtin_attrs | CVf_CVGV_RC;
+		CvFLAGS(compcv) | existing_builtin_attrs | CVf_NAMED;
 	    CvOUTSIDE(cv) = CvOUTSIDE(compcv);
 	    CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(compcv);
 	    CvPADLIST(cv) = CvPADLIST(compcv);
@@ -7077,7 +7068,10 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     else {
 	cv = compcv;
 	*spot = cv;
-	CvGV_set(cv, gv);
+	SvANY(cv)->xcv_gv_u.xcv_hek =
+	    share_hek(SvPVX(namesv)+1,
+		      SvCUR(namesv)-1 * (SvUTF8(namesv) ? -1 : 1), 0);
+	CvNAMED_on(cv);
     }
     CvFILE_set_from_cop(cv, PL_curcop);
     CvSTASH_set(cv, PL_curstash);
@@ -7155,7 +7149,13 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 					  CopFILE(PL_curcop),
 					  (long)PL_subline,
 					  (long)CopLINE(PL_curcop));
-	    gv_efullname3(tmpstr, gv, NULL);
+	    if (HvNAME_HEK(PL_curstash)) {
+		sv_sethek(tmpstr, HvNAME_HEK(PL_curstash));
+		sv_catpvs(tmpstr, "::");
+	    }
+	    else sv_setpvs(tmpstr, "__ANON__::");
+	    sv_catpvn_flags(tmpstr, SvPVX(namesv)+1, SvCUR(namesv)-1,
+			    SvUTF8(namesv) ? SV_CATUTF8 : SV_CATBYTES);
 	    (void)hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr),
 		    SvUTF8(tmpstr) ? -(I32)SvCUR(tmpstr) : (I32)SvCUR(tmpstr), sv, 0);
 	    hv = GvHVn(db_postponed);