Avoid vivifying stuff when looking up barewords

Till now, when a bareword was looked up to see whether it was a sub-
routine, an rv2cv op was created (to allow PL_check hooks to override
the process), which was then asked for its GV.

Afterwards, the GV was downgraded back to nothing if possible.

So a lot of the time a GV was autovivified and then discarded.  This
has been the case since f74617600 (5.12).

If we know there is a good chance that the rv2cv op is about to be
deleted, we can avoid that by passing a flag to the new op.

Also f74617600 actually changed the behaviour by vivifying stashes
that used not be vivified:

sub foo { print shift, "\n" }
SUPER::foo bar if 0;
foo SUPER;

Output in 5.10:

    SUPER

Output as of this commit:

    SUPER

Output in 5.12 to 5.21.3:

    Can't locate object method "foo" via package "SUPER" at - line 3.

4 files changed, 52 insertions, 10 deletions

diff --git a/op.c b/op.c
index abeea58ee8..02ace5d96f 100644
--- a/op.c
+++ b/op.c
@@ -7147,6 +7147,7 @@ Perl_cv_const_sv_or_av(const CV * const cv)
 {
     if (!cv)
 	return NULL;
+    if (SvROK(cv)) return SvRV((SV *)cv);
     assert (SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM);
     return CvCONST(cv) ? MUTABLE_SV(CvXSUBANY(cv).any_ptr) : NULL;
 }
@@ -8830,6 +8831,10 @@ Perl_ck_rvconst(pTHX_ OP *o)
 
     if (kid->op_type == OP_CONST) {
 	int iscv;
+	const int noexpand = o->op_type == OP_RV2CV
+			  && o->op_private & OPpMAY_RETURN_CONSTANT
+				? GV_NOEXPAND
+				: 0;
 	GV *gv;
 	SV * const kidsv = kid->op_sv;
 
@@ -8870,7 +8875,9 @@ Perl_ck_rvconst(pTHX_ OP *o)
 	iscv = (o->op_type == OP_RV2CV) * 2;
 	do {
 	    gv = gv_fetchsv(kidsv,
-		iscv | !(kid->op_private & OPpCONST_ENTERED),
+		noexpand
+		    ? noexpand
+		    : iscv | !(kid->op_private & OPpCONST_ENTERED),
 		iscv
 		    ? SVt_PVCV
 		    : o->op_type == OP_RV2SV
@@ -8880,7 +8887,8 @@ Perl_ck_rvconst(pTHX_ OP *o)
 			    : o->op_type == OP_RV2HV
 				? SVt_PVHV
 				: SVt_PVGV);
-	} while (!gv && !(kid->op_private & OPpCONST_ENTERED) && !iscv++);
+	} while (!noexpand && !gv && !(kid->op_private & OPpCONST_ENTERED)
+	      && !iscv++);
 	if (gv) {
 	    kid->op_type = OP_GV;
 	    SvREFCNT_dec(kid->op_sv);
@@ -8889,7 +8897,7 @@ Perl_ck_rvconst(pTHX_ OP *o)
 	    assert (sizeof(PADOP) <= sizeof(SVOP));
 	    kPADOP->op_padix = pad_alloc(OP_GV, SVf_READONLY);
 	    SvREFCNT_dec(PAD_SVl(kPADOP->op_padix));
-	    GvIN_PAD_on(gv);
+	    if (isGV(gv)) GvIN_PAD_on(gv);
 	    PAD_SETSV(kPADOP->op_padix, MUTABLE_SV(SvREFCNT_inc_simple_NN(gv)));
 #else
 	    kid->op_sv = SvREFCNT_inc_simple_NN(gv);
@@ -10077,7 +10085,7 @@ Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags)
     CV *cv;
     GV *gv;
     PERL_ARGS_ASSERT_RV2CV_OP_CV;
-    if (flags & ~(RV2CVOPCV_MARK_EARLY|RV2CVOPCV_RETURN_NAME_GV))
+    if (flags & ~RV2CVOPCV_FLAG_MASK)
 	Perl_croak(aTHX_ "panic: rv2cv_op_cv bad flags %x", (unsigned)flags);
     if (cvop->op_type != OP_RV2CV)
 	return NULL;
@@ -10089,6 +10097,11 @@ Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags)
     switch (rvop->op_type) {
 	case OP_GV: {
 	    gv = cGVOPx_gv(rvop);
+	    if (!isGV(gv)) {
+		if (flags & RV2CVOPCV_RETURN_STUB)
+		    return (CV *)gv;
+		else return NULL;
+	    }
 	    cv = GvCVu(gv);
 	    if (!cv) {
 		if (flags & RV2CVOPCV_MARK_EARLY)
diff --git a/op.h b/op.h
index c76f37d74a..6070326b20 100644
--- a/op.h
+++ b/op.h
@@ -214,13 +214,13 @@ is no conversion of op type.
 
   bit  entersub flag       phase   rv2cv flag             phase
   ---  -------------       -----   ----------             -----
-    1  OPpENTERSUB_INARGS  context OPpMAY_RETURN_CONSTANT context
+    1  OPpENTERSUB_INARGS  context
     2  HINT_STRICT_REFS    check   HINT_STRICT_REFS       check
     4  OPpENTERSUB_HASTARG check
     8                              OPpENTERSUB_AMPER      parser
    16  OPpENTERSUB_DB      check
    32  OPpDEREF_AV         context
-   64  OPpDEREF_HV         context
+   64  OPpDEREF_HV         context OPpMAY_RETURN_CONSTANT context
   128  OPpLVAL_INTRO       context OPpENTERSUB_NOPAREN    parser
 
 */
@@ -238,7 +238,7 @@ is no conversion of op type.
   /* OP_RV2CV only */
 #define OPpENTERSUB_AMPER	8	/* Used & form to call. */
 #define OPpENTERSUB_NOPAREN	128	/* bare sub call (without parens) */
-#define OPpMAY_RETURN_CONSTANT	1	/* If a constant sub, return the constant */
+#define OPpMAY_RETURN_CONSTANT	64	/* If a constant sub, return the constant */
 
   /* OP_GV only */
 #define OPpEARLY_CV		32	/* foo() called before sub foo was parsed */
@@ -878,6 +878,8 @@ preprocessing token; the type of I<arg> depends on I<which>.
 
 #define RV2CVOPCV_MARK_EARLY     0x00000001
 #define RV2CVOPCV_RETURN_NAME_GV 0x00000002
+#define RV2CVOPCV_RETURN_STUB    0x00000004
+#define RV2CVOPCV_FLAG_MASK      0x00000007 /* all of the above */
 
 #define op_lvalue(op,t) Perl_op_lvalue_flags(aTHX_ op,t,0)
 
diff --git a/t/op/stash.t b/t/op/stash.t
index 598811487d..4c846b7ec4 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -7,7 +7,7 @@ BEGIN {
 
 BEGIN { require "./test.pl"; }
 
-plan( tests => 49 );
+plan( tests => 50 );
 
 # Used to segfault (bug #15479)
 fresh_perl_like(
@@ -318,3 +318,12 @@ ok eval '
      sub foo{};
      1
   ', 'no crashing or errors when clobbering the current package';
+
+# Bareword lookup should not vivify stashes
+is runperl(
+    prog =>
+      'sub foo { print shift, qq-\n- } SUPER::foo bar if 0; foo SUPER',
+    stderr => 1,
+   ),
+   "SUPER\n",
+   'bareword lookup does not vivify stashes';
diff --git a/toke.c b/toke.c
index 98fd125dc0..4e7ae3b84d 100644
--- a/toke.c
+++ b/toke.c
@@ -6560,8 +6560,11 @@ Perl_yylex(pTHX)
 		{
 		    OP *const_op = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(sv));
 		    const_op->op_private = OPpCONST_BARE;
-		    rv2cv_op = newCVREF(0, const_op);
-		    cv = lex ? GvCV(gv) : rv2cv_op_cv(rv2cv_op, 0);
+		    rv2cv_op =
+			newCVREF(OPpMAY_RETURN_CONSTANT<<8, const_op);
+		    cv = lex
+			? GvCV(gv)
+			: rv2cv_op_cv(rv2cv_op, RV2CVOPCV_RETURN_STUB);
 		}
 
 		/* See if it's the indirect object for a list operator. */
@@ -6675,6 +6678,7 @@ Perl_yylex(pTHX)
 		/* Not a method, so call it a subroutine (if defined) */
 
 		if (cv) {
+		    OP *gvop;
 		    if (lastchar == '-' && penultchar != '-') {
 			const STRLEN l = len ? len : strlen(PL_tokenbuf);
  			Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
@@ -6699,6 +6703,20 @@ Perl_yylex(pTHX)
 			TOKEN(WORD);
 		    }
 
+		    /* Resolve to GV now if this is a placeholder. */
+		    if ((gvop = cUNOPx(rv2cv_op)->op_first)
+		     && gvop->op_type == OP_GV) {
+			GV *gv2 = cGVOPx_gv(gvop);
+			if (gv2 && !isGV(gv2)) {
+			    gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV);
+			    assert (SvTYPE(gv) == SVt_PVGV);
+			    /* cv must have been some sort of placeholder,
+			       so now needs replacing with a real code
+			       reference.  */
+			    cv = GvCV(gv);
+			}
+		    }
+
 		    op_free(pl_yylval.opval);
 		    pl_yylval.opval =
 			off ? (OP *)newCVREF(0, rv2cv_op) : rv2cv_op;