This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #119949] Stop undef *_, goto &sub from crashing
authorFather Chrysostomos <sprout@cpan.org>
Sun, 19 Jan 2014 03:16:55 +0000 (19:16 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 19 Jan 2014 05:29:02 +0000 (21:29 -0800)
Commit 049bd5ffd62b fixed problems with the wrong @_ being visible
after *_ modification followed by goto.  In so doing, it made it
possible for a null to be placed at the start of the target sub’s
pad, because it was not checking that the array it got from PL_defgv
was actually non-null.  Simply adding the check makes everything work.

pp_ctl.c
t/op/goto.t

index 2b7b3a9..d0a56ba 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2932,8 +2932,10 @@ PP(pp_goto) /* also pp_dump */
                       to freed memory as the result of undef *_.  So put
                       it in the callee’s pad, donating our refer-
                       ence count. */
-                   SvREFCNT_dec(PAD_SVl(0));
-                   PAD_SVl(0) = (SV *)(cx->blk_sub.argarray = arg);
+                   if (arg) {
+                       SvREFCNT_dec(PAD_SVl(0));
+                       PAD_SVl(0) = (SV *)(cx->blk_sub.argarray = arg);
+                   }
 
                    /* GvAV(PL_defgv) might have been modified on scope
                       exit, so restore it. */
index 5c96f8b..13e6b04 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 92;
+plan tests => 94;
 our $TODO;
 
 my $deprecated = 0;
@@ -498,6 +498,23 @@ eval { & { sub { goto &utf8::encode } } };
 # *_{ARRAY} was untouched, too.
 is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist';
 
+# goto &perlsub when @_ itself does not exist [perl #119949]
+# This was only crashing when the replaced sub call had an argument list.
+# (I.e., &{ sub { goto ... } } did not crash.)
+sub {
+    undef *_;
+    goto sub {
+       is *_{ARRAY}, undef, 'goto &perlsub when @_ does not exist';
+    }
+}->();
+sub {
+    local *_;
+    goto sub {
+       is *_{ARRAY}, undef, 'goto &sub when @_ does not exist (local *_)';
+    }
+}->();
+
+
 # [perl #36521] goto &foo in warn handler could defeat recursion avoider
 
 {