From: Gurusamy Sarathy Date: Fri, 30 Jun 2000 04:37:33 +0000 (+0000) Subject: dounwind() may cause POPSUB() to diddle the wrong PL_curpad X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7032098e3624717c340da3e1b7cc1d22959257c0;p=p5sagit%2Fp5-mst-13.2.git dounwind() may cause POPSUB() to diddle the wrong PL_curpad when @_ is modified, causing coredumps p4raw-id: //depot/perl@6291 --- diff --git a/cop.h b/cop.h index e0a8127..4584a96 100644 --- a/cop.h +++ b/cop.h @@ -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); \ diff --git a/pp_ctl.c b/pp_ctl.c index 06bb964..9af9e82 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -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; diff --git a/pp_hot.c b/pp_hot.c index 6bec999..aefaf16 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -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 48bf5af..ce2c398 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";