This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Name lexical constants
authorFather Chrysostomos <sprout@cpan.org>
Sun, 2 Jun 2013 01:39:33 +0000 (18:39 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 2 Jun 2013 18:54:55 +0000 (11:54 -0700)
$ ./perl -Ilib -Mfeature=:all -e 'my sub a(){44} a()'
The lexical_subs feature is experimental at -e line 1.
Assertion failed: (hek), function Perl_ck_subr, file op.c, line 10558.
Abort trap: 6

The experimental warning is expected.  The assertion failure is not.

When a call checker is invoked, the name of the subroutine is passed
to it.  op.c:ck_subr gets the name from the CV’s cv (CvGV) or, in the
case of lexical subs, from its name hek (CvNAME_HEK).  If neither
exists, ck_subr cannot cope.

Lexical subs never have a GV pointer.  Lexical constants were acci-
dentally having neither a GV pointer nor a hek.  They should have a
hek, like other lexical subs.

op.c
t/op/lexsub.t

diff --git a/op.c b/op.c
index 792e8d6..95609f0 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7167,7 +7167,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        op_free(block);
        SvREFCNT_dec(compcv);
        PL_compcv = NULL;
-       goto clone;
+       goto setname;
     }
     /* Checking whether outcv is CvOUTSIDE(compcv) is not sufficient to
        determine whether this sub definition is in the same scope as its
@@ -7230,6 +7230,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        cv = compcv;
        *spot = cv;
     }
+   setname:
     if (!CvNAME_HEK(cv)) {
        CvNAME_HEK_set(cv,
         hek
@@ -7239,6 +7240,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                      0)
        );
     }
+    if (const_sv) goto clone;
+
     CvFILE_set_from_cop(cv, PL_curcop);
     CvSTASH_set(cv, PL_curstash);
 
index 8d768cc..b6960e0 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     *bar::like = *like;
 }
 no warnings 'deprecated';
-plan 130;
+plan 132;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -299,6 +299,8 @@ sub make_anon_with_state_sub{
     is ref $_[0], 'ARRAY', 'state sub with proto';
   }
   p(my @a);
+  state sub q () { 45 }
+  is q(), 45, 'state constant called with parens';
 }
 {
   state sub x;
@@ -596,6 +598,8 @@ not_lexical11();
     is ref $_[0], 'ARRAY', 'my sub with proto';
   }
   p(my @a);
+  my sub q () { 46 }
+  is q(), 46, 'my constant called with parens';
 }
 {
   my sub x;