From: Vincent Pit <perl@profvince.com>
Date: Thu, 3 Jun 2010 09:44:15 +0000 (+0200)
Subject: Make pp_reverse fetch the lexical $_ from the correct pad
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=789bd863840ef4ff6c46f7c2ee0f3f64e0b5daa6;p=p5sagit%2Fp5-mst-13.2.git

Make pp_reverse fetch the lexical $_ from the correct pad

This is achieved by introducing a new find_rundefsv() function in pad.c

This fixes [perl #75436].
---

diff --git a/embed.fnc b/embed.fnc
index 8e463c1..6400f3e 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -856,6 +856,8 @@ p	|PADOFFSET|allocmy	|NN const char *const name|const STRLEN len\
 : Used in op.c and toke.c
 AMpdR	|PADOFFSET|pad_findmy	|NN const char* name|STRLEN len|U32 flags
 Ap	|PADOFFSET|find_rundefsvoffset	|
+: Used in pp.c
+Ap	|SV*	|find_rundefsv	|
 : Used in perly.y
 pR	|OP*	|oopsAV		|NN OP* o
 : Used in perly.y
diff --git a/embed.h b/embed.h
index 90e8045..588c50a 100644
--- a/embed.h
+++ b/embed.h
@@ -673,6 +673,7 @@
 #endif
 #define pad_findmy		Perl_pad_findmy
 #define find_rundefsvoffset	Perl_find_rundefsvoffset
+#define find_rundefsv		Perl_find_rundefsv
 #ifdef PERL_CORE
 #define oopsAV			Perl_oopsAV
 #define oopsHV			Perl_oopsHV
@@ -3106,6 +3107,7 @@
 #endif
 #define pad_findmy(a,b,c)	Perl_pad_findmy(aTHX_ a,b,c)
 #define find_rundefsvoffset()	Perl_find_rundefsvoffset(aTHX)
+#define find_rundefsv()		Perl_find_rundefsv(aTHX)
 #ifdef PERL_CORE
 #define oopsAV(a)		Perl_oopsAV(aTHX_ a)
 #define oopsHV(a)		Perl_oopsHV(aTHX_ a)
diff --git a/global.sym b/global.sym
index 8861fca..5ab0090 100644
--- a/global.sym
+++ b/global.sym
@@ -396,6 +396,7 @@ Perl_ninstr
 Perl_op_free
 Perl_pad_findmy
 Perl_find_rundefsvoffset
+Perl_find_rundefsv
 Perl_pad_sv
 Perl_reentrant_size
 Perl_reentrant_init
diff --git a/pad.c b/pad.c
index 477ee0f..e8ba139 100644
--- a/pad.c
+++ b/pad.c
@@ -704,6 +704,28 @@ Perl_find_rundefsvoffset(pTHX)
 }
 
 /*
+ * Returns a lexical $_, if there is one, at run time ; or the global one
+ * otherwise.
+ */
+
+SV *
+Perl_find_rundefsv(pTHX)
+{
+    SV *namesv;
+    int flags;
+    PADOFFSET po;
+
+    po = pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+	    NULL, &namesv, &flags);
+
+    if (po == NOT_IN_PAD
+	|| (SvFLAGS(namesv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR))
+	return DEFSV;
+
+    return PAD_SVl(po);
+}
+
+/*
 =for apidoc pad_findlex
 
 Find a named lexical anywhere in a chain of nested pads. Add fake entries
diff --git a/pod/perl5132delta.pod b/pod/perl5132delta.pod
index fe457730..613f814 100644
--- a/pod/perl5132delta.pod
+++ b/pod/perl5132delta.pod
@@ -182,7 +182,7 @@ XXX Changes which affect the interface available to C<XS> code go here.
 =item *
 
 The following new functions or macros have been added to the public API:
-C<SvNV_nomg>,  C<sv_2nv_flags>.
+C<SvNV_nomg>,  C<sv_2nv_flags>, C<find_rundefsv>.
 
 =back
 
diff --git a/pp.c b/pp.c
index 937fdfd..2649c7e 100644
--- a/pp.c
+++ b/pp.c
@@ -5489,19 +5489,12 @@ PP(pp_reverse)
 	register I32 tmp;
 	dTARGET;
 	STRLEN len;
-	PADOFFSET 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
-		    : (padoff_du = find_rundefsvoffset(),
-			(padoff_du == NOT_IN_PAD
-			 || PAD_COMPNAME_FLAGS_isOUR(padoff_du))
-			? DEFSV : PAD_SVl(padoff_du)));
-
+	    sv_setsv(TARG, SP > MARK ? *SP : find_rundefsv());
 	    if (! SvOK(TARG) && ckWARN(WARN_UNINITIALIZED))
 		report_uninit(TARG);
 	}
diff --git a/proto.h b/proto.h
index 6ccf19c..c27313c 100644
--- a/proto.h
+++ b/proto.h
@@ -2510,6 +2510,7 @@ PERL_CALLCONV PADOFFSET	Perl_pad_findmy(pTHX_ const char* name, STRLEN len, U32
 	assert(name)
 
 PERL_CALLCONV PADOFFSET	Perl_find_rundefsvoffset(pTHX);
+PERL_CALLCONV SV*	Perl_find_rundefsv(pTHX);
 PERL_CALLCONV OP*	Perl_oopsAV(pTHX_ OP* o)
 			__attribute__warn_unused_result__
 			__attribute__nonnull__(pTHX_1);
diff --git a/t/op/reverse.t b/t/op/reverse.t
index 2fa0877..916724c 100644
--- a/t/op/reverse.t
+++ b/t/op/reverse.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 23;
+plan tests => 26;
 
 is(reverse("abc"), "cba");
 
@@ -91,3 +91,15 @@ use Tie::Array;
     my $c = scalar reverse($b);
     is($a, $c);
 }
+
+{
+    # Lexical $_.
+    sub blurp { my $_ = shift; reverse }
+
+    is(blurp("foo"), "oof");
+    is(sub { my $_ = shift; reverse }->("bar"), "rab");
+    {
+        local $_ = "XXX";
+        is(blurp("paz"), "zap");
+    }
+}