From ad39f3a27b57b8caeb757155ed38da916b768bc1 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Mon, 9 Sep 2013 01:59:33 -0700
Subject: [PATCH] Make &xsub and goto &xsub work with tied @_
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

This is the only place where tied @_ does not work, and there appears
to be no reason why it shouldn’t, apart from the fact that it hasn’t
been implemented.

Commit 67955e0c was what made &xsub work to begin with.  93965878572
introduced tied arrays and added the comment to pp_entersub saying
that @_ is not tiable.

goto &xsub has worked since perl 5.000, but 93965878572 did not make
it work with tied arrays.
---
 pp_ctl.c   | 24 +++++++++++++++---------
 pp_hot.c   | 13 +++++++++++--
 t/op/tie.t | 18 ++++++++++++++++++
 3 files changed, 44 insertions(+), 11 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 243bcac..bab301e 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2895,7 +2895,8 @@ PP(pp_goto) /* also pp_dump */
 		OP* const retop = cx->blk_sub.retop;
 		SV **newsp;
 		I32 gimme;
-		const SSize_t items = arg ? AvFILLp(arg) + 1 : 0;
+		const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
+		const bool m = arg ? SvRMAGICAL(arg) : 0;
 		SV** mark;
 
                 PERL_UNUSED_VAR(newsp);
@@ -2904,20 +2905,25 @@ PP(pp_goto) /* also pp_dump */
 		/* put GvAV(defgv) back onto stack */
 		if (items) {
 		    EXTEND(SP, items+1); /* @_ could have been extended. */
-		    Copy(AvARRAY(arg), SP + 1, items, SV*);
 		}
 		mark = SP;
-		SP += items;
-		if (items && AvREAL(arg)) {
+		if (items) {
 		    SSize_t index;
+		    bool r = cBOOL(AvREAL(arg));
 		    for (index=0; index<items; index++)
-			if (SP[-index])
-			    SvREFCNT_inc_void_NN(sv_2mortal(SP[-index]));
-			else {
-			    SP[-index] = sv_2mortal(newSVavdefelem(arg,
-						 AvFILLp(arg) - index, 1));
+		    {
+			SV *sv;
+			if (m) {
+			    SV ** const svp = av_fetch(arg, index, 0);
+			    sv = svp ? *svp : NULL;
 			}
+			else sv = AvARRAY(arg)[index];
+			SP[index+1] = sv
+			    ? r ? SvREFCNT_inc_NN(sv_2mortal(sv)) : sv
+			    : sv_2mortal(newSVavdefelem(arg, index, 1));
+		    }
 		}
+		SP += items;
 		SvREFCNT_dec(arg);
 		if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
 		    /* Restore old @_ */
diff --git a/pp_hot.c b/pp_hot.c
index 9641b19..1155328 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2715,17 +2715,26 @@ try_autoload:
 	     * switch stack to @_, and copy return values
 	     * back. This would allow popping @_ in XSUB, e.g.. XXXX */
 	    AV * const av = GvAV(PL_defgv);
-	    const SSize_t items = AvFILLp(av) + 1;  /* @_ is not tieable */
+	    const SSize_t items = AvFILL(av) + 1;
 
 	    if (items) {
 		SSize_t i = 0;
+		const bool m = cBOOL(SvRMAGICAL(av));
 		/* Mark is at the end of the stack. */
 		EXTEND(SP, items);
 		for (; i < items; ++i)
-		    if (AvARRAY(av)[i]) SP[i+1] = AvARRAY(av)[i];
+		{
+		    SV *sv;
+		    if (m) {
+			SV ** const svp = av_fetch(av, i, 0);
+			sv = svp ? *svp : NULL;
+		    }
+		    else sv = AvARRAY(av)[i];
+		    if (sv) SP[i+1] = sv;
 		    else {
 			SP[i+1] = newSVavdefelem(av, i, 1);
 		    }
+		}
 		SP += items;
 		PUTBACK ;		
 	    }
diff --git a/t/op/tie.t b/t/op/tie.t
index eb53030..06a39c4 100644
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -1404,3 +1404,21 @@ print "ok\n" if (eval{ $h{foo} = 1 }||$@) eq (eval{ $h{bar} = 1 }||$@);
 EXPECT
 main
 ok
+########
+
+# &xsub and goto &xsub with tied @_
+use Tie::Array;
+tie @_, Tie::StdArray;
+@_ = "\xff";
+&utf8::encode;
+printf "%x\n", $_ for map ord, split //, $_[0];
+print "--\n";
+@_ = "\xff";
+& {sub { goto &utf8::encode }};
+printf "%x\n", $_ for map ord, split //, $_[0];
+EXPECT
+c3
+bf
+--
+c3
+bf
-- 
2.7.4