From: Robin Houston <robin@cpan.org>
Date: Sat, 22 Oct 2005 16:56:27 +0000 (+0100)
Subject: Re: do { EXPR for EXPR }
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=59110972a700be97092ffbe48afc82fe1bc6445b;p=p5sagit%2Fp5-mst-13.2.git

Re: do { EXPR for EXPR }
Message-ID: <20051022155627.GA22420@rpc142.cs.man.ac.uk>

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

diff --git a/op.c b/op.c
index 19eb99c..97f6a7f 100644
--- a/op.c
+++ b/op.c
@@ -1864,8 +1864,15 @@ Perl_scope(pTHX_ OP *o)
 	    o->op_type = OP_SCOPE;
 	    o->op_ppaddr = PL_ppaddr[OP_SCOPE];
 	    kid = ((LISTOP*)o)->op_first;
-	    if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
+	    if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
 		op_null(kid);
+
+		/* The following deals with things like 'do {1 for 1}' */
+		kid = kid->op_sibling;
+		if (kid &&
+		    (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE))
+		    op_null(kid);
+	    }
 	}
 	else
 	    o = newLISTOP(OP_SCOPE, 0, o, Nullop);
diff --git a/t/cmd/mod.t b/t/cmd/mod.t
index e2ab777..d427d78 100755
--- a/t/cmd/mod.t
+++ b/t/cmd/mod.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: mod.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:11 $
 
-print "1..12\n";
+print "1..13\n";
 
 print "ok 1\n" if 1;
 print "not ok 1\n" unless 1;
@@ -52,3 +52,6 @@ print "not ok 11\n" unless $x < 0;
 print "ok 12\n" unless $x > 0;
 print "not ok 12\n" if $x > 0;
 
+# This used to cause a segfault
+$x = "".("".do{"foo" for (1)});
+print "ok 13\n";