From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Wed, 2 Jun 2004 06:07:53 +0000 (+0000)
Subject: Make the dUNDERBAR/UNDERBAR macros work as advertised.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e1f795dc699c88c2d9eb4a46fe629483760393c2;p=p5sagit%2Fp5-mst-13.2.git

Make the dUNDERBAR/UNDERBAR macros work as advertised.
While we're at it, use the same trick to make reverse()
work correctly with lexical $_.

p4raw-id: //depot/perl@22889
---

diff --git a/XSUB.h b/XSUB.h
index a1e48dd..563d331 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -114,7 +114,7 @@ is a lexical $_ in scope.
 #define XSINTERFACE_FUNC_SET(cv,f)	\
 		CvXSUBANY(cv).any_dxptr = (void (*) (pTHX_ void*))(f)
 
-#define dUNDERBAR I32 padoff_du = pad_findmy("$_")
+#define dUNDERBAR I32 padoff_du = Perl_find_rundefsvoffset()
 #define UNDERBAR ((padoff_du == NOT_IN_PAD \
 	    || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR) \
 	? DEFSV : PAD_SVl(padoff_du))
diff --git a/embed.fnc b/embed.fnc
index 1ee63c3..b69b792 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -551,6 +551,7 @@ p	|void	|package	|OP* o
 pd	|PADOFFSET|pad_alloc	|I32 optype|U32 tmptype
 p	|PADOFFSET|allocmy	|char* name
 pd	|PADOFFSET|pad_findmy	|char* name
+Ap	|PADOFFSET|find_rundefsvoffset	|
 p	|OP*	|oopsAV		|OP* o
 p	|OP*	|oopsHV		|OP* o
 pd	|void	|pad_leavemy
diff --git a/embed.h b/embed.h
index 4eef0bf..96b6d7c 100644
--- a/embed.h
+++ b/embed.h
@@ -761,6 +761,7 @@
 #ifdef PERL_CORE
 #define pad_findmy		Perl_pad_findmy
 #endif
+#define find_rundefsvoffset	Perl_find_rundefsvoffset
 #ifdef PERL_CORE
 #define oopsAV			Perl_oopsAV
 #endif
@@ -3387,6 +3388,7 @@
 #ifdef PERL_CORE
 #define pad_findmy(a)		Perl_pad_findmy(aTHX_ a)
 #endif
+#define find_rundefsvoffset()	Perl_find_rundefsvoffset(aTHX)
 #ifdef PERL_CORE
 #define oopsAV(a)		Perl_oopsAV(aTHX_ a)
 #endif
diff --git a/global.sym b/global.sym
index 46b6458..d97151e 100644
--- a/global.sym
+++ b/global.sym
@@ -329,6 +329,7 @@ Perl_vstringify
 Perl_vcmp
 Perl_ninstr
 Perl_op_free
+Perl_find_rundefsvoffset
 Perl_pad_sv
 Perl_reentrant_size
 Perl_reentrant_init
diff --git a/pad.c b/pad.c
index d7799c9..0b0491c 100644
--- a/pad.c
+++ b/pad.c
@@ -582,6 +582,19 @@ Perl_pad_findmy(pTHX_ char *name)
     return NOT_IN_PAD;
 }
 
+/*
+ * Returns the offset of a lexical $_, if there is one, at run time.
+ * Used by the UNDERBAR XS macro.
+ */
+
+PADOFFSET
+Perl_find_rundefsvoffset()
+{
+    SV *out_sv;
+    int out_flags;
+    return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+	    Null(SV**), &out_sv, &out_flags);
+}
 
 /*
 =for apidoc pad_findlex
diff --git a/pp.c b/pp.c
index 60eaf28..c0c7420 100644
--- a/pp.c
+++ b/pp.c
@@ -4334,12 +4334,17 @@ PP(pp_reverse)
 	register I32 tmp;
 	dTARGET;
 	STRLEN len;
+	I32 padoff_du;
 
 	SvUTF8_off(TARG);				/* decontaminate */
 	if (SP - MARK > 1)
 	    do_join(TARG, &PL_sv_no, MARK, SP);
 	else
-	    sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
+	    sv_setsv(TARG, (SP > MARK)
+		    ? *SP
+		    : (padoff_du = Perl_find_rundefsvoffset(),
+			(padoff_du == NOT_IN_PAD || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR)
+			? DEFSV : PAD_SVl(padoff_du)));
 	up = SvPV_force(TARG, len);
 	if (len > 1) {
 	    if (DO_UTF8(TARG)) {	/* first reverse each character */
diff --git a/proto.h b/proto.h
index 9dcf1c8..39a5e20 100644
--- a/proto.h
+++ b/proto.h
@@ -529,6 +529,7 @@ PERL_CALLCONV void	Perl_package(pTHX_ OP* o);
 PERL_CALLCONV PADOFFSET	Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype);
 PERL_CALLCONV PADOFFSET	Perl_allocmy(pTHX_ char* name);
 PERL_CALLCONV PADOFFSET	Perl_pad_findmy(pTHX_ char* name);
+PERL_CALLCONV PADOFFSET	Perl_find_rundefsvoffset(pTHX);
 PERL_CALLCONV OP*	Perl_oopsAV(pTHX_ OP* o);
 PERL_CALLCONV OP*	Perl_oopsHV(pTHX_ OP* o);
 PERL_CALLCONV void	Perl_pad_leavemy(pTHX);
diff --git a/t/op/mydef.t b/t/op/mydef.t
index 485f843..f089c31 100644
--- a/t/op/mydef.t
+++ b/t/op/mydef.t
@@ -164,7 +164,7 @@ $_ = "global";
 {
     my $_ = "abc";
     my $x = reverse;
-    ok( $x eq "cba", 'reverse without arguments picks up $_ # TODO' );
+    ok( $x eq "cba", 'reverse without arguments picks up $_' );
 }
 
 {