In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/439cdf38ae50bdfe6ca11c86ccc3917d6b56ec45?hp=87f4ab41b64991a57643a80d84f9ca824fbdb9a4>
- Log ----------------------------------------------------------------- commit 439cdf38ae50bdfe6ca11c86ccc3917d6b56ec45 Author: David Mitchell <[email protected]> Date: Sat Jul 24 16:11:12 2010 +0100 small code tweak in Perl_gv_init (follow-up to previous commit, fix for #76540) M gv.c commit e5c69c9b913b1a7f8a83beabb60e96958df29689 Author: David Mitchell <[email protected]> Date: Sat Jul 24 15:41:19 2010 +0100 [perl #76540] "print CONSTANT," gives double-free gv_init() has name and len args, but newCONSTSUB() (which it calls) doesn't have a len arg, so any trailing garbage in name gets used by newCONSTSUB. In the test case, this means that we end up attaching the const CV to both the "FOO" and qq{FOO, "\\n";\n} GVs. So it gets freed twice. M dist/constant/t/constant.t M gv.c ----------------------------------------------------------------------- Summary of changes: dist/constant/t/constant.t | 15 ++++++++++++++- gv.c | 13 +++++++++++-- 2 files changed, 25 insertions(+), 3 deletions(-) diff --git a/dist/constant/t/constant.t b/dist/constant/t/constant.t index 85a9355..793ac0a 100644 --- a/dist/constant/t/constant.t +++ b/dist/constant/t/constant.t @@ -9,7 +9,7 @@ END { @warnings && print STDERR join "\n- ", "accumulated warnings:", @warnings use strict; -use Test::More tests => 96; +use Test::More tests => 97; my $TB = Test::More->builder; BEGIN { use_ok('constant'); } @@ -347,3 +347,16 @@ $kloong = 'schlozhauer'; eval 'use constant undef, 5; 1'; like $@, qr/\ACan't use undef as constant name at /; } + +# [perl #76540] +# this caused panics or 'Attempt to free unreferenced scalar' +# (its a compile-time issue, so the die lets us skip the prints) + +eval <<EOF; +use constant FOO => 'bar'; +die "made it"; +print FOO, "\n"; +print FOO, "\n"; +EOF +like($@, qr/made it/, "#76540"); + diff --git a/gv.c b/gv.c index a5c33d9..6f63f4b 100644 --- a/gv.c +++ b/gv.c @@ -288,8 +288,17 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) CV *cv; ENTER; if (has_constant) { + char *name0 = NULL; + if (name[len]) + /* newCONSTSUB doesn't take a len arg, so make sure we + * give it a \0-terminated string */ + name0 = savepvn(name,len); + /* newCONSTSUB takes ownership of the reference from us. */ - cv = newCONSTSUB(stash, name, has_constant); + cv = newCONSTSUB(stash, (name0 ? name0 : name), has_constant); + assert(GvCV(gv) == cv); /* newCONSTSUB should have set this */ + if (name0) + Safefree(name0); /* If this reference was a copy of another, then the subroutine must have been "imported", by a Perl space assignment to a GV from a reference to CV. */ @@ -298,8 +307,8 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) } else { (void) start_subparse(0,0); /* Create empty CV in compcv. */ cv = PL_compcv; + GvCV(gv) = cv; } - GvCV(gv) = cv; LEAVE; mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar($) { (shift) } sub ASDF::baz($); *ASDF::baz = \&Foo::bar */ -- Perl5 Master Repository
