From 9da346da98617273964d333ee33ca5cdbddae4a1 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 31 Aug 2011 22:44:57 -0700
Subject: [PATCH] [perl #97484] Make defined &{...} vivify CORE subs

Magical variables usually get autovivified, even in rvalue context,
because  Perl is trying to pretend they have been there all along.
That means defined(${"."}) will autovivify $. and return true.

Until CORE subs were introduced, there were no subroutines that popped
into existence when looked at.

This commit makes rv_2cv use the GV_ADDMG flag added in commit
23496c6ea.  When this flag is passed, gv_fetchpvn_flags creates a GV
but does not add it to the stash until it finds out that it is creat-
ing a magical one.  The CORE sub code calls newATTRSUB, which expects
to add the CV to the stash itself.  So the gv has to be added there
and then.  So gv_fetchpvn_flags is also adjusted to add the gv to the
stash right before calling newATTRSUB, and to tell itself that the
GV_ADDMG flag is actually off.

It might be better to move the CV-creation code into op.c and inline
parts of newATTRSUB, to avoid fiddling with the addmg variable (and
avoid prototype checks on CORE subs), but that refactoring should
probably come in separate commits.
---
 gv.c            | 6 +++++-
 pp.c            | 2 +-
 sv.c            | 2 +-
 t/op/coresubs.t | 6 ++++--
 4 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/gv.c b/gv.c
index e4c1d21..07ff3b2 100644
--- a/gv.c
+++ b/gv.c
@@ -1050,7 +1050,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
     const I32 no_expand = flags & GV_NOEXPAND;
     const I32 add = flags & ~GV_NOADD_MASK;
-    const bool addmg = !!(flags & GV_ADDMG);
+    bool addmg = !!(flags & GV_ADDMG);
     const char *const name_end = nambeg + full_len;
     const char *const name_em1 = name_end - 1;
     U32 faking_it;
@@ -1402,6 +1402,10 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	           new ATTRSUB. */
 	    (void)core_prototype((SV *)cv, name, code, &opnum);
 	    if (ampable) {
+		if (addmg) {
+		    hv_store(stash,name,len,(SV *)gv,0);
+		    addmg = FALSE;
+		}
 		CvLVALUE_on(cv);
 		newATTRSUB(oldsavestack_ix,
 		           newSVOP(
diff --git a/pp.c b/pp.c
index ab933c9..c732c5b 100644
--- a/pp.c
+++ b/pp.c
@@ -427,7 +427,7 @@ PP(pp_rv2cv)
     GV *gv;
     HV *stash_unused;
     const I32 flags = (PL_op->op_flags & OPf_SPECIAL)
-	? 0
+	? GV_ADDMG
 	: ((PL_op->op_private & (OPpLVAL_INTRO|OPpMAY_RETURN_CONSTANT)) == OPpMAY_RETURN_CONSTANT)
 	    ? GV_ADD|GV_NOEXPAND
 	    : GV_ADD;
diff --git a/sv.c b/sv.c
index df0092c..2acfafc 100644
--- a/sv.c
+++ b/sv.c
@@ -8884,7 +8884,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
 	}
 	*st = GvESTASH(gv);
     fix_gv:
-	if (lref && !GvCVu(gv)) {
+	if (lref & ~GV_ADDMG && !GvCVu(gv)) {
 	    SV *tmpsv;
 	    ENTER;
 	    tmpsv = newSV(0);
diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index e646553..f0ebe8e 100644
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -31,10 +31,12 @@ while(<$kh>) {
     chomp(my $word = $');
     if($& eq '+' || $unsupported{$word}) {
       $tests ++;
-      ok !defined &{\&{"CORE::$word"}}, "no CORE::$word";
+      ok !defined &{"CORE::$word"}, "no CORE::$word";
     }
     else {
-      $tests += 3;
+      $tests += 4;
+
+      ok defined &{"CORE::$word"}, "defined &{'CORE::$word'}";
 
       my $proto = prototype "CORE::$word";
       *{"my$word"} = \&{"CORE::$word"};
-- 
2.7.4