Re: overriding builtins quirk

[p5sagit/p5-mst-13.2.git] / t / op / closure.t

diff --git a/t/op/closure.t b/t/op/closure.t
index 09df7c1..6a81a44 100755 (executable)
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use Config;
 
-print "1..171\n";
+print "1..181\n";
 
 my $test = 1;
 sub test (&) {
@@ -510,3 +510,97 @@ END
 
 }
 
+# The following dumps core with perl <= 5.8.0 (bugid 9535) ...
+BEGIN { $vanishing_pad = sub { eval $_[0] } }
+$some_var = 123;
+test { $vanishing_pad->( '$some_var' ) == 123 };
+
+# ... and here's another coredump variant - this time we explicitly
+# delete the sub rather than using a BEGIN ...
+
+sub deleteme { $a = sub { eval '$newvar' } }
+deleteme();
+*deleteme = sub {}; # delete the sub
+$newvar = 123; # realloc the SV of the freed CV
+test { $a->() == 123 };
+
+# ... and a further coredump variant - the fixup of the anon sub's
+# CvOUTSIDE pointer when the middle eval is freed, wasn't good enough to
+# survive the outer eval also being freed.
+
+$x = 123;
+$a = eval q(
+    eval q[
+       sub { eval '$x' }
+    ]
+);
+@a = ('\1\1\1\1\1\1\1') x 100; # realloc recently-freed CVs
+test { $a->() == 123 };
+
+# this coredumped on <= 5.8.0 because evaling the closure caused
+# an SvFAKE to be added to the outer anon's pad, which was then grown.
+my $outer;
+sub {
+    my $x;
+    $x = eval 'sub { $outer }';
+    $x->();
+    $a = [ 99 ];
+    $x->();
+}->();
+test {1};
+
+# [perl #17605] found that an empty block called in scalar context
+# can lead to stack corruption
+{
+    my $x = "foooobar";
+    $x =~ s/o//eg;
+    test { $x eq 'fbar' }
+}
+
+# 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 {
+               test { sub {eval'$x'}->() == 1 };
+       { $x;   test { sub {eval'$x'}->() == 1 } }
+               test { sub {eval'$x'}->() == 1 };
+    }
+}
+fake();
+
+# undefining a sub shouldn't alter visibility of outer lexicals
+
+{
+    $x = 1;
+    my $x = 2;
+    sub tmp { sub { eval '$x' } }
+    my $a = tmp();
+    undef &tmp;
+    test { $a->() == 2 };
+}
+
+# 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);
+    test { $watch eq '12' }
+}