better handle freeing of code blocks in /(?{...})/

[perl5.git] / t / op / closure.t

diff --git a/t/op/closure.t b/t/op/closure.t
index 2cea6c8..9d3de7f 100644 (file)
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -8,8 +8,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use Config;
@@ -654,33 +654,21 @@ __EOF__
 }
 
 sub f {
-    my $x if $_[0];
-    sub { \$x }
+    my $x;
+    format ff =
+@
+$r = \$x
+.
 }
 
 {
-    f(1);
-    my $c1= f(0);
-    my $c2= f(0);
-
-    my $r1 = $c1->();
-    my $r2 = $c2->();
+    fileno ff;
+    write ff;
+    my $r1 = $r;
+    write ff;
+    my $r2 = $r;
     isnt($r1, $r2,
-        "don't copy a stale lexical; crate a fresh undef one instead");
-}
-
-# [perl #63540] Don’t treat sub { if(){.....}; "constant" } as a constant
-
-BEGIN {
-  my $x = 7;
-  *baz = sub() { if($x){ () = "tralala"; blonk() }; 0 }
-}
-{
-  my $blonk_was_called;
-  *blonk = sub { ++$blonk_was_called };
-  my $ret = baz();
-  is($ret, 0, 'RT #63540');
-  is($blonk_was_called, 1, 'RT #63540');
+        "don't copy a stale lexical; create a fresh undef one instead");
 }
 
 # test PL_cv_has_eval.  Any anon sub that could conceivably contain an
@@ -733,5 +721,94 @@ do "./op/closure_test.pl" or die $@||$!;
 is $closure_test::s2->()(), '10 cubes',
   'cloning closure proto with no CvOUTSIDE';
 
+# Also brought up in #113812: Even when being cloned, a closure prototype
+# might have its CvOUTSIDE pointing to the wrong thing.
+{
+    package main::113812;
+    $s1 = sub {
+       my $x = 3;
+       $s2 = sub {
+           $x;
+           $s3 = sub { $x };
+       };
+    };
+    $s1->();
+    undef &$s1; # frees $s2's prototype, causing the $s3 proto to have its
+                # CvOUTSIDE point to $s1
+    ::is $s2->()(), 3, 'cloning closure proto whose CvOUTSIDE has changed';
+}
+
+# This should never emit two different values:
+#     print $x, "\n";
+#     print sub { $x }->(), "\n";
+# This test case started to do just that in commit 33894c1aa3e
+# (5.10.1/5.12.0):
+sub mosquito {
+    my $x if @_;
+    return if @_;
+
+    $x = 17;
+    is sub { $x }->(), $x, 'closing over stale var in 2nd sub call';
+}
+mosquito(1);
+mosquito;
+# And this case in commit adf8f095c588 (5.14):
+sub anything {
+    my $x;
+    sub gnat {
+       $x = 3;
+       is sub { $x }->(), $x,
+           'closing over stale var before 1st sub call';
+    }
+}
+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;
+
+# [perl #114888]
+# Test that closure creation localises PL_comppad_name properly.  Usually
+# at compile time a BEGIN block will localise PL_comppad_name for use, so
+# pp_anoncode can mess with it without any visible effects.
+# But inside a source filter, it affects the directly enclosing compila-
+# tion scope.
+SKIP: {
+    skip_if_miniperl("no XS on miniperl (for source filters)");
+    fresh_perl_is <<'    [perl #114888]', "ok\n", {stderr=>1},
+       use strict;
+       BEGIN {
+           package Foo;
+           use Filter::Util::Call;
+           sub import { filter_add( sub {
+               my $status = filter_read();
+               sub { $status };
+               $status;
+           })}
+           Foo->import
+       }
+       my $x = "ok\n"; # stores $x in the wrong padnamelist
+       print $x;       # cannot find it - strict violation
+    [perl #114888]
+        'closures in source filters do not interfere with pad names';
+}
+
+sub {
+    my $f;
+    sub test_ref_to_unavailable {
+       my $ref = \$f;
+        $$ref = 7;
+        is $f, 7, 'taking a ref to unavailable var should not copy it';
+    }
+};
+test_ref_to_unavailable();
 
 done_testing();