[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 (file)
--- 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 (file)
--- 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 (executable)
--- 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: