develooper Front page | perl.perl5.porters | Postings from March 2003

[PATCH] [perl #9990] avoid goto &tmpsub coredump

Thread Next
From:
Dave Mitchell
Date:
March 18, 2003 13:55
Subject:
[PATCH] [perl #9990] avoid goto &tmpsub coredump
Message ID:
20030318215505.A16787@fdgroup.com
Bug #9990 demonstrates a coredump, which can be reduced to the following:

    sub f { my $x; my $a = sub { $x }; goto $a } f();

Basically the goto first unwinds f's scope, which causes $a to be freed;
then it tries to call &$a. Bang.....

This patch makes pp_goto add an extra ref to the CV for the duration.

-- 
You live and learn (although usually you just live).


# This is a patch for 19021.ORIG to update it to 19021
# 
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'patch' program with this file as input.
#
#### End of Preamble ####

#### Patch data follows ####
diff -up '19021.ORIG/pp_ctl.c' '19021/pp_ctl.c'
Index: ./pp_ctl.c
--- ./pp_ctl.c	Tue Mar 18 21:21:58 2003
+++ ./pp_ctl.c	Tue Mar 18 21:38:14 2003
@@ -2203,6 +2203,7 @@ PP(pp_goto)
 	    }
 
 	    /* First do some returnish stuff. */
+	    SvREFCNT_inc(cv); /* avoid premature free during unwind */
 	    FREETMPS;
 	    cxix = dopoptosub(cxstack_ix);
 	    if (cxix < 0)
@@ -2250,6 +2251,7 @@ PP(pp_goto)
 
 	    /* Now do some callish stuff. */
 	    SAVETMPS;
+	    SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
 	    if (CvXSUB(cv)) {
 #ifdef PERL_XSUB_OLDSTYLE
 		if (CvOLDSTYLE(cv)) {
diff -up '19021.ORIG/t/op/goto.t' '19021/t/op/goto.t'
Index: ./t/op/goto.t
--- ./t/op/goto.t	Tue Mar 18 21:22:18 2003
+++ ./t/op/goto.t	Tue Mar 18 21:28:24 2003
@@ -2,7 +2,7 @@
 
 # "This IS structured code.  It's just randomly structured."
 
-print "1..27\n";
+print "1..28\n";
 
 while ($?) {
     $foo = 1;
@@ -177,6 +177,14 @@ print ($ok ? "ok 22\n" : "not ok 22\n");
     print "ok 27 - weird case of goto and for(;;) loop\n";
 }
 
+# bug #9990 - don't prematurely free the CV we're &going to.
+
+sub f1 {
+    my $x;
+    goto sub { $x; print "ok 28 - don't prematurely free CV\n" }
+}
+f1();
+
 exit;
 
 bypass:
#### End of Patch data ####

#### ApplyPatch data follows ####
# Data version        : 1.0
# Date generated      : Tue Mar 18 21:40:00 2003
# Generated by        : makepatch 2.00_05
# Recurse directories : Yes
# Excluded files      : keywords\.h|warnings\.h|regnodes\.h|perlapi\.c|perlapi\.h|global\.sym|embedvar\.h|embed\.h|pod\/perlapi\.pod|pod\/perlintern\.pod|proto\.h
# v 'patchlevel.h' 4571 1048022560 33188
# p 'pp_ctl.c' 87366 1048023494 0100644
# p 't/op/goto.t' 4052 1048022904 0100755
#### End of ApplyPatch data ####

#### End of Patch kit [created: Tue Mar 18 21:40:00 2003] ####
#### Patch checksum: 63 1851 1920 ####
#### Checksum: 81 2526 57466 ####

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About