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

2 files changed, 23 insertions, 2 deletions

diff --git a/dist/constant/t/constant.t b/dist/constant/t/constant.t
index 85a9355a19..793ac0a72d 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 73d14caaa1..eb97d9d475 100644
--- a/gv.c
+++ b/gv.c
@@ -251,8 +251,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.  */