This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #114018] Let eval close over stale vars in active sub
authorFather Chrysostomos <sprout@cpan.org>
Wed, 8 Aug 2012 17:00:52 +0000 (10:00 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 8 Aug 2012 19:24:53 +0000 (12:24 -0700)
See also commit cae5dbbe30.

These two lines should never produce different values:

    print $x, "\n";
    print eval '$x', "\n";

But they were producing different values if $x happened to have the
tale flag set.  Even if my in false conditional is not supported (this
was the cause of the bug report), it should still work; and it is
not the only way to get a stale lexical in an active sub (just the
easiest way).

As long as the sub containing the eval is active, the eval should be
able to see the same variables, stale or not.

However, this does get a bit tricky in cases like this, which legiti-
mately warn (from t/lib/warnings/pad):

{
    my $x = 1;
    $y = \$x; # force abandonment rather than clear-in-place at scope exit
    sub f2 { eval '$x' }
}
f2();

In this case the f2 sub does not explicitly close over the $x, so by
the time the eval is reached the ‘right’ $x is gone.

It is only in those cases where the sub containing the eval has
the stale variable in its own pad that we can safely ignore the
stale flag.

pad.c
pad.h
t/op/closure.t

diff --git a/pad.c b/pad.c
index 01813f8..e8f8a43 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1123,12 +1123,14 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
     SV *new_capture;
     SV **new_capturep;
     const AV * const padlist = CvPADLIST(cv);
+    const bool staleok = !!(flags & padadd_STALEOK);
 
     PERL_ARGS_ASSERT_PAD_FINDLEX;
 
-    if (flags & ~padadd_UTF8_NAME)
+    if (flags & ~(padadd_UTF8_NAME|padadd_STALEOK))
        Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf,
                   (UV)flags);
+    flags &= ~ padadd_STALEOK; /* one-shot flag */
 
     *out_flags = 0;
 
@@ -1279,6 +1281,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        PTR2UV(cv), PTR2UV(*out_capture)));
 
                    if (SvPADSTALE(*out_capture)
+                       && (!CvDEPTH(cv) || !staleok)
                        && !SvPAD_STATE(name_svp[offset]))
                    {
                        Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
@@ -1313,7 +1316,9 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
     new_capturep = out_capture ? out_capture :
                CvLATE(cv) ? NULL : &new_capture;
 
-    offset = pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
+    offset = pad_findlex(namepv, namelen,
+               flags | padadd_STALEOK*(new_capturep == &new_capture),
+               CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
                new_capturep, out_name_sv, out_flags);
     if ((PADOFFSET)offset == NOT_IN_PAD)
        return NOT_IN_PAD;
diff --git a/pad.h b/pad.h
index 139cb06..712bdab 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -126,6 +126,8 @@ typedef enum {
 #define padadd_OUR             0x01       /* our declaration. */
 #define padadd_STATE           0x02       /* state declaration. */
 #define padadd_NO_DUP_CHECK    0x04       /* skip warning on dups. */
+#define padadd_STALEOK         0x08       /* allow stale lexical in active
+                                           * sub, but only one level up */
 #define padadd_UTF8_NAME       SVf_UTF8   /* name is UTF-8 encoded. */
 
 /* ASSERT_CURPAD_LEGAL and ASSERT_CURPAD_ACTIVE respectively determine
index 73b43e4..756ad04 100644 (file)
@@ -777,5 +777,16 @@ sub anything {
 }
 gnat();
 
+# [perl #114018] Similar to the above, but with string eval
+sub staleval {
+    my $x if @_;
+    return if @_;
+
+    $x = 3;
+    is eval '$x', $x, 'eval closing over stale var in active sub';
+    return # 
+}
+staleval 1;
+staleval;
 
 done_testing();