[perl #129916] Allow sub-in-stash outside of main

The sub-in-stash optimization introduced in 2eaf799e only applied to
subs in the main stash, not in other stashes, due to a problem with
the logic in newATTRSUB.

This comment:

	   Also, we may be called from load_module at run time, so
	   PL_curstash (which sets CvSTASH) may not point to the stash the
	   sub is stored in.

explains why we need the PL_curstash != CopSTASH(PL_curcop) check.
(Perl_load_module will fail without it.) But that logic does not work
properly at compile time (when PL_curcop == &PL_compiling).

The value of CopSTASH(&PL_compiling) is never actually used.  It is
always set to the main stash.  So if we check that PL_curstash !=
CopSTASH(PL_curcop) and forego the optimization in that case, we will
never optimize subs outside of the main stash.

What we really need is to check IN_PERL_RUNTIME && PL_curstash !=
opSTASH(PL_curcop).  I.e., forego the optimization at run time if the
stashes differ.  That is what this commit implements.

One observable side effect of this change is that deleting a stash
element no longer anonymizes the CV if the CV had no GV that it was
depending on to provide its name.  Since the main thing in such situa-
tions is that we do not get a crash, I think this change (arguably an
improvement) is acceptable.)

-----------

A bit of explanation of various other changes:

gv.c:require_tie_mod needed a bit of help, since it could not handle
sub refs in stashes.

To keep localisation of stash elements working the same way,
local($Stash::{foo}) now upgrades a coderef to a full GV before the
localisation.  (Changes in two pp*.c files and in scope.c:save_gp.)

t/op/stash.t contains a test that makes sure that perl does not crash
when a GV with a CV pointing to it gets deleted.  This commit tweaks
the test so that it continues to test that.  (There has to be a GV for
the test to test what it is meant to test.)

Similarly with t/uni/caller.t and t/uni/stash.t.

op.c:rv2cv_op_cv with the _MAYBE_NAME_GV flag was returning the cal-
ling GV in those cases where a GV-less sub is called via a GV.  E.g.,
*main = \&Foo::foo; main().  This meant that errors like ‘Not enough
arguments’ were giving the wrong sub name.

newATTRSUB was not calling mro_method_changed_in when storing a
sub as an RV.

gv_init needs to arrange for the new GV to have the file and line num-
ber corresponding to the sub in it.  These are taken from CvSTART,
which may be off by a few lines, but is the closest we have to the
place the sub was declared.

1 files changed, 18 insertions, 5 deletions

diff --git a/gv.c b/gv.c
index eebf542e47..5d963328e4 100644
--- a/gv.c
+++ b/gv.c
@@ -373,6 +373,9 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
     const U32 proto_utf8  = proto ? SvUTF8(gv) : 0;
     SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
     const U32 exported_constant = has_constant ? SvPCS_IMPORTED(gv) : 0;
+    const bool really_sub =
+	has_constant && SvTYPE(has_constant) == SVt_PVCV;
+    COP * const old = PL_curcop;
 
     PERL_ARGS_ASSERT_GV_INIT_PVN;
     assert (!(proto && has_constant));
@@ -411,14 +414,19 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
     SvIOK_off(gv);
     isGV_with_GP_on(gv);
 
+    if (really_sub && !CvISXSUB(has_constant) && CvSTART(has_constant)
+     && (  CvSTART(has_constant)->op_type == OP_NEXTSTATE
+	|| CvSTART(has_constant)->op_type == OP_DBSTATE))
+	PL_curcop = (COP *)CvSTART(has_constant);
     GvGP_set(gv, Perl_newGP(aTHX_ gv));
+    PL_curcop = old;
     GvSTASH(gv) = stash;
     if (stash)
 	Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(gv));
     gv_name_set(gv, name, len, GV_ADD | ( flags & SVf_UTF8 ? SVf_UTF8 : 0 ));
     if (flags & GV_ADDMULTI || doproto)	/* doproto means it */
 	GvMULTI_on(gv);			/* _was_ mentioned */
-    if (has_constant && SvTYPE(has_constant) == SVt_PVCV) {
+    if (really_sub) {
 	/* Not actually a constant.  Just a regular sub.  */
 	CV * const cv = (CV *)has_constant;
 	GvCV_set(gv,cv);
@@ -1342,11 +1350,16 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name,
       PUSHSTACKi(PERLSI_MAGIC);
       ENTER;
 
-#define HV_FETCH_TIE_FUNC (GV **)hv_fetchs(stash, "_tie_it", 0)
+#define GET_HV_FETCH_TIE_FUNC				 \
+    (  (gvp = (GV **)hv_fetchs(stash, "_tie_it", 0))	  \
+    && *gvp						   \
+    && (  (isGV(*gvp) && GvCV(*gvp))			    \
+       || (SvROK(*gvp) && SvTYPE(SvRV(*gvp)) == SVt_PVCV)  ) \
+    )
 
       /* Load the module if it is not loaded.  */
       if (!(stash = gv_stashpvn(name, len, 0))
-       || !(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
+       || ! GET_HV_FETCH_TIE_FUNC)
       {
 	SV * const module = newSVpvn(name, len);
 	const char type = varname == '[' ? '$' : '%';
@@ -1358,12 +1371,12 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name,
 	if (!stash)
 	    Perl_croak(aTHX_ "panic: Can't use %c%c because %s is not available",
 		    type, varname, name);
-	else if (!(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
+	else if (! GET_HV_FETCH_TIE_FUNC)
 	    Perl_croak(aTHX_ "panic: Can't use %c%c because %s does not define _tie_it",
 		    type, varname, name);
       }
       /* Now call the tie function.  It should be in *gvp.  */
-      assert(gvp); assert(*gvp); assert(GvCV(*gvp));
+      assert(gvp); assert(*gvp);
       PUSHMARK(SP);
       XPUSHs((SV *)gv);
       PUTBACK;