[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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' };
+}
+
+
+