From: Dave Mitchell <davem@fdisolutions.com>
Date: Sat, 17 Jan 2004 16:12:32 +0000 (+0000)
Subject:  [perl #24914] freeing a CV reference that was currently being
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b3a3b3a1da8f5142edf3e194532b08316f895282;p=p5sagit%2Fp5-mst-13.2.git

 [perl #24914] freeing a CV reference that was currently being
 executed caused coredumps

p4raw-id: //depot/perl@22167
---

diff --git a/perl.c b/perl.c
index f32e346..aa37e2f 100644
--- a/perl.c
+++ b/perl.c
@@ -699,6 +699,9 @@ perl_destruct(pTHXx)
     SvFLAGS(PL_fdpid) |= SVTYPEMASK;		/* don't clean out pid table now */
     SvFLAGS(PL_strtab) |= SVTYPEMASK;		/* don't clean out strtab now */
 
+    PL_comppad = Null(PAD*);
+    PL_curpad = Null(SV**);
+
     /* the 2 is for PL_fdpid and PL_strtab */
     while (PL_sv_count > 2 && sv_clean_all())
 	;
diff --git a/scope.c b/scope.c
index 2c2ce36..1da8ebe 100644
--- a/scope.c
+++ b/scope.c
@@ -1045,8 +1045,10 @@ Perl_leave_scope(pTHX_ I32 base)
 	    break;
 	case SAVEt_COMPPAD:
 	    PL_comppad = (PAD*)SSPOPPTR;
-	    if (PL_comppad)
+	    if (PL_comppad) {
 		PL_curpad = AvARRAY(PL_comppad);
+		SvREFCNT_dec(PL_comppad);
+	    }		    
 	    else
 		PL_curpad = Null(SV**);
 	    break;
diff --git a/scope.h b/scope.h
index 50b40fa..c0bd344 100644
--- a/scope.h
+++ b/scope.h
@@ -167,6 +167,7 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 	SSCHECK(2);						\
 	SSPUSHPTR((SV*)PL_comppad);				\
 	SSPUSHINT(SAVEt_COMPPAD);				\
+	SvREFCNT_inc(PL_comppad);				\
     } STMT_END
 
 #ifdef USE_ITHREADS
diff --git a/sv.c b/sv.c
index 6e64702..bc53cc4 100644
--- a/sv.c
+++ b/sv.c
@@ -10830,7 +10830,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 	    break;
 	case SAVEt_COMPPAD:
 	    av = (AV*)POPPTR(ss,ix);
-	    TOPPTR(nss,ix) = av_dup(av, param);
+	    TOPPTR(nss,ix) = av_dup_inc(av, param);
 	    break;
 	case SAVEt_PADSV:
 	    longval = (long)POPLONG(ss,ix);
diff --git a/t/op/closure.t b/t/op/closure.t
index 2425a59..f9da311 100755
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use Config;
 
-print "1..185\n";
+print "1..186\n";
 
 my $test = 1;
 sub test (&) {
@@ -668,4 +668,16 @@ __EOF__
     END { 1 while unlink $progfile }
 }
 
+{
+    # bugid #24914 = used to coredump restoring PL_comppad in the
+    # savestack, due to the early freeing of the anon closure
+
+    my $got = runperl(stderr => 1, prog => 
+'sub d {die} my $f; $f = sub {my $x=1; $f = 0; d}; eval{$f->()}; print qw(ok)'
+    );
+    test { $got eq 'ok' };
+}
+
+
+