From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Fri, 11 Oct 2002 19:53:05 +0000 (+0000)
Subject: Fix bug #17771 : segfault with the 'for' statement modifier
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fb14229d046006b2f5d3159b99a4486315081739;p=p5sagit%2Fp5-mst-13.2.git

Fix bug #17771 : segfault with the 'for' statement modifier
used inside a map or a grep.

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

diff --git a/pp_ctl.c b/pp_ctl.c
index b6393de..0359935 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -836,7 +836,7 @@ PP(pp_mapwhile)
 	}
 	/* copy the new items down to the destination list */
 	dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1;
-	while (items--)
+	while (items-- > 0)
 	    *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
     }
     LEAVE;					/* exit inner scope */
diff --git a/t/op/grep.t b/t/op/grep.t
index 3a7f8ad..d488527 100755
--- a/t/op/grep.t
+++ b/t/op/grep.t
@@ -4,7 +4,7 @@
 # grep() and map() tests
 #
 
-print "1..27\n";
+print "1..32\n";
 
 $test = 1;
 
@@ -97,3 +97,35 @@ sub ok {
              { $_ & "X" } ("ok $test\n");
    $test++;
 }
+
+# Tests for "for" in "map" and "grep"
+# Used to dump core, bug [perl #17771]
+
+{
+    my @x;
+    my $y = '';
+    @x = map { $y .= $_ for 1..2; 1 } 3..4;
+    print "# @x,$y\n";
+    print "@x,$y" eq "1 1,1212" ? "ok $test\n" : "not ok $test\n";
+    $test++;
+    $y = '';
+    @x = map { $y .= $_ for 1..2; $y .= $_ } 3..4;
+    print "# @x,$y\n";
+    print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n";
+    $test++;
+    $y = '';
+    @x = map { for (1..2) { $y .= $_ } $y .= $_ } 3..4;
+    print "# @x,$y\n";
+    print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n";
+    $test++;
+    $y = '';
+    @x = grep { $y .= $_ for 1..2; 1 } 3..4;
+    print "# @x,$y\n";
+    print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n";
+    $test++;
+    $y = '';
+    @x = grep { for (1..2) { $y .= $_ } 1 } 3..4;
+    print "# @x,$y\n";
+    print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n";
+    $test++;
+}