From db4cf31d1d6c1d09bce93986aa993818ea7b17cf Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Fri, 17 Aug 2012 13:01:49 -0700
Subject: Fix format closure bug with redefined outer sub
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

CVs close over their outer CVs.  So, when you write:

my $x = 52;
sub foo {
  sub bar {
    sub baz {
      $x
    }
  }
}

baz’s CvOUTSIDE pointer points to bar, bar’s CvOUTSIDE points to foo,
and foo’s to the main cv.

When the inner reference to $x is looked up, the CvOUTSIDE chain is
followed, and each sub’s pad is looked at to see if it has an $x.
(This happens at compile time.)

It can happen that bar is undefined and then redefined:

undef &bar;
eval 'sub bar { my $x = 34 }';

After this, baz will still refer to the main cv’s $x (52), but, if baz
had  ‘eval '$x'’ instead of just $x, it would see the new bar’s $x.
(It’s not really a new bar, as its refaddr is the same, but it has a
new body.)

This particular case is harmless, and is obscure enough that we could
define it any way we want, and it could still be considered correct.

The real problem happens when CVs are cloned.

When a CV is cloned, its name pad already contains the offsets into
the parent pad where the values are to be found.  If the outer CV
has been undefined and redefined, those pad offsets can be com-
pletely bogus.

Normally, a CV cannot be cloned except when its outer CV is running.
And the outer CV cannot have been undefined without also throwing
away the op that would have cloned the prototype.

But formats can be cloned when the outer CV is not running.  So it
is possible for cloned formats to close over bogus entries in a new
parent pad.

In this example, \$x gives us an array ref.  It shows ARRAY(0xbaff1ed)
instead of SCALAR(0xdeafbee):

sub foo {
    my $x;
format =
@
($x,warn \$x)[0]
.
}
undef &foo;
eval 'sub foo { my @x; write }';
foo
__END__

And if the offset that the format’s pad closes over is beyond the end
of the parent’s new pad, we can even get a crash, as in this case:

eval
'sub foo {' .
'{my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)}'x999
. q|
    my $x;
format =
@
($x,warn \$x)[0]
.
}
|;
undef &foo;
eval 'sub foo { my @x; my $x = 34; write }';
foo();
__END__

So now, instead of using CvROOT to identify clones of
CvOUTSIDE(format), we use the padlist ID instead.  Padlists don’t
actually have an ID, so we give them one.  Any time a sub is cloned,
the new padlist gets the same ID as the old.  The format needs to
remember what its outer sub’s padlist ID was, so we put that in the
padlist struct, too.
---
 intrpvar.h | 1 +
 1 file changed, 1 insertion(+)

(limited to 'intrpvar.h')

diff --git a/intrpvar.h b/intrpvar.h
index c27e33893f..7dc9021adf 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -778,6 +778,7 @@ PERLVAR(I, custom_ops,	HV *)		/* custom op registrations */
 PERLVARI(I, globhook,	globhook_t, NULL)
 
 PERLVARI(I, glob_index,	int,	0)
+PERLVARI(I, padlist_generation, U32, 1)	/* id to identify padlist clones */
 PERLVAR(I, reentrant_retint, int)	/* Integer return value from reentrant functions */
 
 /* The last unconditional member of the interpreter structure when 5.10.0 was
-- 
cgit v1.2.1