+
+# DAPM 24-Nov-02
+# SvFAKE lexicals should be visible thoughout a function.
+# On <= 5.8.0, the third test failed, eg bugid #18286
+
+{
+ my $x = 1;
+ sub fake {
+ is(sub {eval'$x'}->(), 1, 'RT #18286');
+ { $x; is(sub {eval'$x'}->(), 1, 'RT #18286'); }
+ is(sub {eval'$x'}->(), 1, 'RT #18286');
+ }
+}
+fake();
+
+{
+ $x = 1;
+ my $x = 2;
+ sub tmp { sub { eval '$x' } }
+ my $a = tmp();
+ undef &tmp;
+ is($a->(), 2,
+ "undefining a sub shouldn't alter visibility of outer lexicals");
+}
+
+# handy class: $x = Watch->new(\$foo,'bar')
+# causes 'bar' to be appended to $foo when $x is destroyed
+sub Watch::new { bless [ $_[1], $_[2] ], $_[0] }
+sub Watch::DESTROY { ${$_[0][0]} .= $_[0][1] }
+
+# bugid 1028:
+# nested anon subs (and associated lexicals) not freed early enough
+
+sub linger {
+ my $x = Watch->new($_[0], '2');
+ sub {
+ $x;
+ my $y;
+ sub { $y; };
+ };
+}
+{
+ my $watch = '1';
+ linger(\$watch);
+ is($watch, '12', 'RT #1028');
+}
+
+# bugid 10085
+# obj not freed early enough
+
+sub linger2 {
+ my $obj = Watch->new($_[0], '2');
+ sub { sub { $obj } };
+}
+{
+ my $watch = '1';
+ linger2(\$watch);
+ is($watch, 12, 'RT #10085');
+}
+
+# bugid 16302 - named subs didn't capture lexicals on behalf of inner subs
+
+{
+ my $x = 1;
+ sub f16302 {
+ sub {
+ is($x, 1, 'RT #16302');
+ }->();
+ }
+}
+f16302();
+
+# The presence of an eval should turn cloneless anon subs into clonable
+# subs - otherwise the CvOUTSIDE of that sub may be wrong
+
+{
+ my %a;
+ for my $x (7,11) {
+ $a{$x} = sub { $x=$x; sub { eval '$x' } };
+ }
+ is($a{7}->()->() + $a{11}->()->(), 18);
+}
+
+{
+ # bugid #23265 - this used to coredump during destruction of PL_maincv
+ # and its children
+
+ fresh_perl_is(<< '__EOF__', "yxx\n", {stderr => 1}, 'RT #23265');
+ print
+ sub {$_[0]->(@_)} -> (
+ sub {
+ $_[1]
+ ? $_[0]->($_[0], $_[1] - 1) . sub {"x"}->()
+ : "y"
+ },
+ 2
+ )
+ , "\n"
+ ;
+__EOF__
+}
+
+{
+ # bugid #24914 = used to coredump restoring PL_comppad in the
+ # savestack, due to the early freeing of the anon closure
+
+ fresh_perl_is('sub d {die} my $f; $f = sub {my $x=1; $f = 0; d}; eval{$f->()}; print qq(ok\n)',
+ "ok\n", {stderr => 1}, 'RT #24914');
+}
+
+
+# After newsub is redefined outside the BEGIN, its CvOUTSIDE should point
+# to main rather than BEGIN, and BEGIN should be freed.
+
+{
+ my $flag = 0;
+ sub X::DESTROY { $flag = 1 }
+ {
+ my $x;
+ BEGIN {$x = \&newsub }
+ sub newsub {};
+ $x = bless {}, 'X';
+ }
+ is($flag, 1);
+}
+
+sub f {
+ my $x;
+ format ff =
+@
+$r = \$x
+.
+}
+
+{
+ 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');
+}
+
+# test PL_cv_has_eval. Any anon sub that could conceivably contain an
+# eval, should be marked as cloneable
+
+{
+
+ my @s;
+ push @s, sub { eval '1' } for 1,2;
+ isnt($s[0], $s[1], "cloneable with eval");
+ @s = ();
+ push @s, sub { use re 'eval'; my $x; s/$x/1/; } for 1,2;
+ isnt($s[0], $s[1], "cloneable with use re eval");
+ @s = ();
+ push @s, sub { s/1/1/ee; } for 1,2;
+ isnt($s[0], $s[1], "cloneable with //ee");
+}
+
+# [perl #89544]
+{
+ sub trace::DESTROY {
+ push @trace::trace, "destroyed";
+ }
+
+ my $outer2 = sub {
+ my $a = bless \my $dummy, trace::;
+
+ my $outer = sub {
+ my $b;
+ my $inner = sub {
+ undef $b;
+ };
+
+ $a;
+
+ $inner
+ };
+
+ $outer->()
+ };
+
+ my $inner = $outer2->();
+ is "@trace::trace", "destroyed",
+ 'closures only close over named variables, not entire subs';
+}
+
+# [perl #113812] Closure prototypes with no CvOUTSIDE (crash caused by the
+# fix for #89544)
+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';
+}
+
+done_testing();