From: Gurusamy Sarathy <gsar@cpan.org>
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";