[prev in list] [next in list] [prev in thread] [next in thread] 

List:       perl5-porters
Subject:    Re: [perl #75436] Segfault with lexical $_ and reverse() since 	e1f795dc
From:       Vincent Pit <perl () profvince ! com>
Date:       2010-05-30 23:11:19
Message-ID: 4C02F097.4020003 () profvince ! com
[Download RAW message or body]

> On 29 May 2010 20:19, Ævar Arnfjörð Bjarmason <perlbug-followup@perl.org> wrote:
>   
>> This segfaults in everything from 5.10 to blead:
>>
>>    perl -e 'sub eek { my $_ = $_[0]; reverse } eek(1)'
>>     
> Thanks for tracing this down.
>
> Some background :
> reverse() without arguments is special, because it defaults to $_ only
> when called in scalar context. That means that, unlike all other
> builtins that default to $_, you can't know at compile time whether it
> will read $_ or not, and you can't put this info in the optree. So you
> have to figure it out later, at runtime.
>
> find_rundefsvoffset() locates a lexical $_ in the pad at runtime;
> however we don't know if it's a "my" or an "our", and in this case the
> segfault is produced in the part of the statement:
> PAD_COMPNAME_FLAGS_isOUR(padoff_du), which doesn't work, because
> apparently it's intended for compile-time, not run-time.
>   
That was also my analysis.

I've attached two patches that fix the issue. Both fetch the name sv
associated with $_ from the current run-time pad instead of the comppad.
The former inlines all the new required code in pp_reverse, while the
second one introduces a new find_rundefsv() function that abstracts this
logic. Since I suspect that the UNDERBAR macro is also wrong (it's
deemed to be called at run-time), my preferred solution would be to
apply the second patch, change UNDERBAR to use find_rundefsv(), and
deprecate find_rundefsvoffset() as I don't think it's really useful in
the end.

Vincent.

["reverse_implicit.patch" (text/plain)]

diff --git a/pp.c b/pp.c
index 937fdfd..4d1ff3c 100644
--- a/pp.c
+++ b/pp.c
@@ -5489,19 +5489,27 @@ 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 *src;
+	    if (SP > MARK)
+		src = *SP;
+	    else {
+		PADOFFSET padoff_du = find_rundefsvoffset();
+		if (padoff_du == NOT_IN_PAD)
+		    src = DEFSV;
+		else {
+		    const CV * const cv = find_runcv(NULL);
+		    const AV * const padlist = CvPADLIST(cv);
+		    const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
+		    const SV * const namesv = AvARRAY(nameav)[padoff_du];
+		    src = ((SvFLAGS(namesv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR)) ? \
DEFSV : PAD_SVl(padoff_du); +		}
+	    }
+	    sv_setsv(TARG, src);
 	    if (! SvOK(TARG) && ckWARN(WARN_UNINITIALIZED))
 		report_uninit(TARG);
 	}
diff --git a/t/op/reverse.t b/t/op/reverse.t
index 2fa0877..08521ad 100644
--- a/t/op/reverse.t
+++ b/t/op/reverse.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 23;
+plan tests => 25;
 
 is(reverse("abc"), "cba");
 
@@ -91,3 +91,11 @@ 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");
+}


["reverse_implicit2.patch" (text/plain)]

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 8015154..9078fba 100644
--- a/pad.c
+++ b/pad.c
@@ -705,6 +705,27 @@ 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/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..08521ad 100644
--- a/t/op/reverse.t
+++ b/t/op/reverse.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 23;
+plan tests => 25;
 
 is(reverse("abc"), "cba");
 
@@ -91,3 +91,11 @@ 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");
+}


[prev in list] [next in list] [prev in thread] [next in thread]