[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.

diff --git a/dist/constant/t/constant.t b/dist/constant/t/constant.t
index 85a9355..793ac0a 100644 (file)
--- 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..a50878f 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -288,8 +288,16 @@ 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);
+           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.  */