This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop &xsub and goto &xsub from crashing on undef *_
authorFather Chrysostomos <sprout@cpan.org>
Fri, 6 Sep 2013 15:30:41 +0000 (08:30 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 7 Sep 2013 06:25:49 +0000 (23:25 -0700)
$ perl -e 'undef *_; &Internals::V'
Segmentation fault: 11
$ perl -e 'sub { undef *_; goto &Internals::V }->()'
$ perl5.18.1 -e 'sub { undef *_; goto &Internals::V }->()'
Segmentation fault: 11

The goto case is actually a regression from 5.16 (049bd5ffd62), as
goto used to ignore changes to *_.  (Fixing one bug uncovers another.)

We shouldn’t assume that GvAV(PL_defgv) (*_{ARRAY}) gives us anything.

While we’re at it, since we have to add extra checks anyway, use them
to speed up empty @_ in goto (by checking items, rather than arg).

pp_ctl.c
pp_hot.c
t/op/goto.t
t/op/sub.t

index 24a8cd6..47d8a1f 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2895,18 +2895,20 @@ PP(pp_goto) /* also pp_dump */
                OP* const retop = cx->blk_sub.retop;
                SV **newsp;
                I32 gimme;
-               const SSize_t items = AvFILLp(arg) + 1;
+               const SSize_t items = arg ? AvFILLp(arg) + 1 : 0;
                SV** mark;
 
                 PERL_UNUSED_VAR(newsp);
                 PERL_UNUSED_VAR(gimme);
 
                /* put GvAV(defgv) back onto stack */
-               EXTEND(SP, items+1); /* @_ could have been extended. */
-               Copy(AvARRAY(arg), SP + 1, items, SV*);
+               if (items) {
+                   EXTEND(SP, items+1); /* @_ could have been extended. */
+                   Copy(AvARRAY(arg), SP + 1, items, SV*);
+               }
                mark = SP;
                SP += items;
-               if (AvREAL(arg)) {
+               if (items && AvREAL(arg)) {
                    I32 index;
                    for (index=0; index<items; index++)
                        if (SP[-index])
index 2598ef0..03ce102 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2714,7 +2714,7 @@ try_autoload:
            !CvLVALUE(cv))
            DIE(aTHX_ "Can't modify non-lvalue subroutine call");
 
-       if (!hasargs) {
+       if (!hasargs && GvAV(PL_defgv)) {
            /* Need to copy @_ to stack. Alternative may be to
             * switch stack to @_, and copy return values
             * back. This would allow popping @_ in XSUB, e.g.. XXXX */
index 1336685..5c96f8b 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 91;
+plan tests => 92;
 our $TODO;
 
 my $deprecated = 0;
@@ -491,6 +491,13 @@ is ${*__}[0], 'rough and tubbery', 'goto &foo leaves reified @_ alone';
     is $_[0], "", 'content of nonexistent $_[0] is modified by goto &xsub';
 }
 
+# goto &xsub when @_ itself does not exist
+undef *_;
+eval { & { sub { goto &utf8::encode } } };
+# The main thing we are testing is that it did not crash.  But make sure 
+# *_{ARRAY} was untouched, too.
+is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist';
+
 # [perl #36521] goto &foo in warn handler could defeat recursion avoider
 
 {
index bbb9d76..2088662 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 29 );
+plan( tests => 30 );
 
 sub empty_sub {}
 
@@ -175,3 +175,10 @@ is eval {
     is @_, 1, 'num of elems in @_ after &xsub with nonexistent $_[0]';
     is $_[0], "", 'content of nonexistent $_[0] is modified by &xsub';
 }
+
+# &xsub when @_ itself does not exist
+undef *_;
+eval { &utf8::encode };
+# The main thing we are testing is that it did not crash.  But make sure 
+# *_{ARRAY} was untouched, too.
+is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist';