This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix CvOUTSIDE for state subs in predeclared subs
authorFather Chrysostomos <sprout@cpan.org>
Sat, 3 Jan 2015 04:15:10 +0000 (20:15 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 4 Jan 2015 00:05:56 +0000 (16:05 -0800)
use 5.018;
use experimental 'lexical_subs';
$::x = "global";
sub x;
sub x {
    state $x = 42;
    state sub x { print eval '$x', "\n" }
    \&x;
}
x()->();
__END__

Output:

Segmentation fault: 11

Because this line in pad.c:S_findpadlex:

1141     const PADLIST * const padlist = CvPADLIST(cv);

is trying to read this SV:

SV = UNKNOWN(0x76) (0xaa170e4fd) at 0x10060c928
  REFCNT = 1697135711
  FLAGS = (PADSTALE,TEMP,GMG,SMG,IOK,pNOK,pPOK,UTF8)

(i.e., gibberish).

During compilation, ‘sub x{’ creates a new CV.  When the sub is about
to be installed (when the final ‘}’ is reached), the existing stub
must be reused.  So everything is copied from the new CV (PL_compcv)
to the stub.  Also, any CvOUTSIDE pointers of nested subs get updated
to point to the erstwhile stub.

State subs were not getting their CvOUTSIDE pointers updated.  This
patch implements that.

pad.c
t/op/lexsub.t

diff --git a/pad.c b/pad.c
index 55d4f4d..25513b7 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -2327,18 +2327,30 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
     PERL_UNUSED_ARG(old_cv);
 
     for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) {
-        const PADNAME * const name = namepad[ix];
-       if (name && name != &PL_padname_undef && !PadnameIsSTATE(name)
+        const PADNAME *name = namepad[ix];
+       if (name && name != &PL_padname_undef && !PadnameIsOUR(name)
            && *PadnamePV(name) == '&')
        {
-         if (SvTYPE(curpad[ix]) == SVt_PVCV) {
+         CV *innercv = MUTABLE_CV(curpad[ix]);
+         if (UNLIKELY(PadnameOUTER(name))) {
+           CV *cv = new_cv;
+           PADNAME **names = namepad;
+           PADOFFSET i = ix;
+           while (PadnameOUTER(name)) {
+               cv = CvOUTSIDE(cv);
+               names = PadlistNAMESARRAY(CvPADLIST(cv));
+               i = PARENT_PAD_INDEX(name);
+               name = names[i];
+           }
+           innercv = (CV *)PadARRAY(PadlistARRAY(CvPADLIST(cv))[1])[i];
+         }
+         if (SvTYPE(innercv) == SVt_PVCV) {
            /* XXX 0afba48f added code here to check for a proto CV
                   attached to the pad entry by magic.  But shortly there-
                   after 81df9f6f95 moved the magic to the pad name.  The
                   code here was never updated, so it wasn’t doing anything
                   and got deleted when PADNAME became a distinct type.  Is
                   there any bug as a result?  */
-           CV * const innercv = MUTABLE_CV(curpad[ix]);
            if (CvOUTSIDE(innercv) == old_cv) {
                if (!CvWEAKOUTSIDE(innercv)) {
                    SvREFCNT_dec(old_cv);
index f43285f..2ba7635 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     *bar::is = *is;
     *bar::like = *like;
 }
-plan 147;
+plan 148;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -431,6 +431,18 @@ is runperl(switches => ['-lXMfeature=:all'],
   like $@, qr/^Undefined subroutine &φου called at /,
     'state sub with utf8 name';
 }
+# This used to crash, but only as a standalone script
+is runperl(switches => ['-lXMfeature=:all'],
+           prog     => '$::x = global=>;
+                        sub x;
+                        sub x {
+                          state $x = 42;
+                          state sub x { print eval q|$x| }
+                          x()
+                        }
+                        x()',
+           stderr   => 1), "42\n",
+  'closure behaviour of state sub in predeclared package sub';
 
 # -------------------- my -------------------- #