From: Dave Mitchell <davem@fdisolutions.com>
Date: Sun, 30 May 2004 14:30:45 +0000 (+0000)
Subject: [perl #29708] Problem with autouse (causing Perl to crash)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ff0adf167b2e3460e75812c6003c4a897c4595fe;p=p5sagit%2Fp5-mst-13.2.git

[perl #29708] Problem with autouse (causing Perl to crash)
@_ sometimes wasn't getting created right

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

diff --git a/pad.c b/pad.c
index 209eb0a..d7799c9 100644
--- a/pad.c
+++ b/pad.c
@@ -1523,6 +1523,9 @@ If has_args is true, give the new pad an @_ in slot zero.
 =cut
 */
 
+/* XXX pad_push is now always called with has_args == 1. Get rid of
+ * this arg at some point */
+
 void
 Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
 {
diff --git a/pp_ctl.c b/pp_ctl.c
index ec21e69..2ed833d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2329,7 +2329,7 @@ PP(pp_goto)
 		else {
 		    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
 			sub_crush_depth(cv);
-		    pad_push(padlist, CvDEPTH(cv), cx->blk_sub.hasargs);
+		    pad_push(padlist, CvDEPTH(cv), 1);
 		}
 		PAD_SET_CUR(padlist, CvDEPTH(cv));
 		if (cx->blk_sub.hasargs)
diff --git a/t/op/goto.t b/t/op/goto.t
index 67d24c0..859d5a6 100755
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -7,7 +7,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-print "1..32\n";
+print "1..33\n";
 
 require "test.pl";
 
@@ -229,6 +229,19 @@ eval { goto +i_return_a_label; };
 print "not ";
 returned_label : print "ok 32 - done to returned_label\n";
 
+# [perl #29708] - goto &foo could leave foo() at depth two with
+# @_ == PL_sv_undef, causing a coredump
+
+
+my $r = runperl(
+    prog =>
+	'sub f { return if $d; $d=1; my $a=sub {goto &f}; &$a; f() } f(); print qq(ok\n)',
+    stderr => 1
+    );
+print "not " if $r ne "ok\n";
+print "ok 33 - avoid pad without an \@_\n";
+
+
 exit;
 
 bypass: