diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 2000-06-30 04:37:33 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 2000-06-30 04:37:33 +0000 |
commit | 7032098e3624717c340da3e1b7cc1d22959257c0 (patch) | |
tree | 04ad10e123399e2ce2574436560a9e2a3d96c671 | |
parent | 0cacb523b3d9abfe9ac5761f31a2c11458e98c49 (diff) | |
download | perl-7032098e3624717c340da3e1b7cc1d22959257c0.tar.gz |
dounwind() may cause POPSUB() to diddle the wrong PL_curpad
when @_ is modified, causing coredumps
p4raw-id: //depot/perl@6291
-rw-r--r-- | cop.h | 3 | ||||
-rw-r--r-- | pp_ctl.c | 2 | ||||
-rw-r--r-- | pp_hot.c | 1 | ||||
-rwxr-xr-x | t/op/args.t | 23 |
4 files changed, 27 insertions, 2 deletions
@@ -80,6 +80,7 @@ struct block_sub { U16 olddepth; U8 hasargs; U8 lval; /* XXX merge lval and hasargs? */ + SV ** oldcurpad; }; #define PUSHSUB(cx) \ @@ -126,7 +127,7 @@ struct block_sub { cx->blk_sub.argarray = newAV(); \ av_extend(cx->blk_sub.argarray, fill); \ AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY; \ - PL_curpad[0] = (SV*)cx->blk_sub.argarray; \ + cx->blk_sub.oldcurpad[0] = (SV*)cx->blk_sub.argarray; \ } \ else { \ CLEAR_ARGARRAY(cx->blk_sub.argarray); \ @@ -913,6 +913,7 @@ PP(pp_sort) cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); #endif /* USE_THREADS */ + cx->blk_sub.oldcurpad = PL_curpad; cx->blk_sub.argarray = av; } qsortsv((myorigmark+1), max, @@ -2308,6 +2309,7 @@ PP(pp_goto) cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); #endif /* USE_THREADS */ + cx->blk_sub.oldcurpad = PL_curpad; cx->blk_sub.argarray = av; ++mark; @@ -2659,6 +2659,7 @@ try_autoload: cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); #endif /* USE_THREADS */ + cx->blk_sub.oldcurpad = PL_curpad; cx->blk_sub.argarray = av; ++MARK; diff --git a/t/op/args.t b/t/op/args.t index 48bf5afec0..ce2c398865 100755 --- a/t/op/args.t +++ b/t/op/args.t @@ -1,6 +1,6 @@ #!./perl -print "1..8\n"; +print "1..9\n"; # test various operations on @_ @@ -52,3 +52,24 @@ sub new4 { goto &new2 } print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y"; print "ok $ord\n"; } + +# see if POPSUB gets to see the right pad across a dounwind() with +# a reified @_ + +sub methimpl { + my $refarg = \@_; + die( "got: @_\n" ); +} + +sub method { + &methimpl; +} + +sub try { + eval { method('foo', 'bar'); }; + print "# $@" if $@; +} + +for (1..5) { try() } +++$ord; +print "ok $ord\n"; |