This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make constant promotion null-clean
authorFather Chrysostomos <sprout@cpan.org>
Sun, 20 Nov 2011 07:39:57 +0000 (23:39 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 20 Nov 2011 22:14:00 +0000 (14:14 -0800)
When an optimised constant is promoted to a CV, the name’s length can
be passed straight to newCONSTSUB_flags, as it now has a length param-
eter which it passes to newXS_len_flags.

gv.c
t/op/gv.t

diff --git a/gv.c b/gv.c
index 1f1ee06..8600665 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -369,23 +369,12 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
        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_flags(
-               stash, (name0 ? name0 : name),
-               strlen(name0 ? name0 : name), flags, has_constant
-           );
+           cv = newCONSTSUB_flags(stash, name, len, flags, has_constant);
            /* In case op.c:S_process_special_blocks stole it: */
            if (!GvCV(gv))
                GvCV_set(gv, (CV *)SvREFCNT_inc_simple_NN(cv));
            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.  */
index b681638..0cb0d39 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan( tests => 238 );
+plan( tests => 239 );
 
 # type coercion on assignment
 $foo = 'foo';
@@ -918,6 +918,18 @@ package HTTP::MobileAttribute::Plugin::Locator {
        "stash elem for slot is not freed prematurely";
 }
 
+# Check that constants promoted to CVs point to the right GVs when the name
+# contains a null.
+package lrcg {
+  use constant x => 3;
+  # These two lines abuse the optimisation that copies the scalar ref from
+  # one stash element to another, to get a constant with a null in its name
+  *{"yz\0a"} = \&{"x"};
+  my $ref = \&{"yz\0a"};
+  ::ok !exists $lrcg::{yz},
+    'constants w/nulls in their names point 2 the right GVs when promoted';
+}
+
 __END__
 Perl
 Rules