jumbo closure fix

Message-ID: <20030226144947.A14444@fdgroup.com>

p4raw-id: //depot/perl@19637

2 files changed, 114 insertions, 11 deletions

diff --git a/t/lib/warnings/pad b/t/lib/warnings/pad
index 7dd28762f1..71f683ed54 100644
--- a/t/lib/warnings/pad
+++ b/t/lib/warnings/pad
@@ -4,21 +4,21 @@
 	my $x;
 	my $x ;
 
-     Variable "%s" may be unavailable 
+     Variable "%s" will not stay shared 
 	sub x {
       	    my $x;
       	    sub y {
-         	$x
+         	sub { $x }
       	    }
    	}
 
-     Variable "%s" will not stay shared 
 	sub x {
       	    my $x;
       	    sub y {
-         	sub { $x }
+         	$x
       	    }
    	}
+
     "our" variable %s redeclared	(Did you mean "local" instead of "our"?)
 	our $x;
 	{
@@ -65,24 +65,89 @@ EXPECT
 # pad.c
 use warnings 'closure' ;
 sub x {
-      our $x;
+      my $x;
       sub y {
-         $x
+         sub { $x }
       }
    }
 EXPECT
+Variable "$x" will not stay shared at - line 6.
+########
+# pad.c
+use warnings 'closure' ;
+sub x {
+    my $x;
+    sub {
+	$x;
+	sub y {
+	    $x
+	}
+    }->();
+}
+EXPECT
+Variable "$x" will not stay shared at - line 9.
+########
+# pad.c
+use warnings 'closure' ;
+my $x;
+sub {
+    $x;
+    sub f {
+	sub { $x }->();
+    }
+}->();
+EXPECT
 
 ########
 # pad.c
 use warnings 'closure' ;
+sub {
+    my $x;
+    sub f { $x }
+}->();
+EXPECT
+Variable "$x" is not available at - line 5.
+########
+# pad.c
+use warnings 'closure' ;
+sub {
+    my $x;
+    eval 'sub f { $x }';
+}->();
+EXPECT
+
+########
+# pad.c
+use warnings 'closure' ;
+sub {
+    my $x;
+    sub f { eval '$x' }
+}->();
+f();
+EXPECT
+Variable "$x" is not available at (eval 1) line 2.
+########
+# pad.c
+use warnings 'closure' ;
 sub x {
-      my $x;
+      our $x;
       sub y {
-         sub { $x }
+         $x
       }
    }
 EXPECT
-Variable "$x" may be unavailable at - line 6.
+
+########
+# pad.c
+# see bugid 1754
+use warnings 'closure' ;
+sub f {
+    my $x;
+    sub { eval '$x' };
+}
+f()->();
+EXPECT
+Variable "$x" is not available at (eval 1) line 2.
 ########
 # pad.c
 no warnings 'closure' ;
diff --git a/t/op/closure.t b/t/op/closure.t
index 6a81a44f36..dd7b50cdef 100755
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use Config;
 
-print "1..181\n";
+print "1..184\n";
 
 my $test = 1;
 sub test (&) {
@@ -255,7 +255,7 @@ END_MARK_ONE
 
 	  $code .=  <<"END_MARK_TWO" if $nc_attempt;
     return if index(\$msg, 'will not stay shared') != -1;
-    return if index(\$msg, 'may be unavailable') != -1;
+    return if index(\$msg, 'is not available') != -1;
 END_MARK_TWO
 
 	  $code .= <<"END_MARK_THREE";		# Backwhack a lot!
@@ -604,3 +604,41 @@ sub linger {
     linger(\$watch);
     test { $watch eq '12' }
 }
+
+# bugid 10085
+# obj not freed early enough
+
+sub linger2 { 
+    my $obj = Watch->new($_[0], '2');
+    sub { sub { $obj } };
+}   
+{
+    my $watch = '1';
+    linger2(\$watch);
+    test { $watch eq '12' }
+}
+
+# bugid 16302 - named subs didn't capture lexicals on behalf of inner subs
+
+{
+    my $x = 1;
+    sub f16302 {
+	sub {
+	    test { defined $x and $x == 1 }
+	}->();
+    }
+}
+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' } };
+    }
+    test { $a{7}->()->() + $a{11}->()->() == 18 };
+}
+
+