From: Jesse Luehrs <doy@tozt.net>
Date: Tue, 2 Aug 2011 05:36:58 +0000 (-0500)
Subject: i always forget that B exists
X-Git-Tag: 0.07~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FEval-Closure.git;a=commitdiff_plain;h=0fb2ea464c6eb6c52831d44ef541a0d4d5c95a92

i always forget that B exists
---

diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm
index 45c36b6..23cf250 100644
--- a/lib/Eval/Closure.pm
+++ b/lib/Eval/Closure.pm
@@ -200,21 +200,23 @@ sub _clean_eval_closure {
         my $source = _make_compiler_source(@_);
 
         unless (exists $compiler_cache{$source}) {
-            local $@;
-            local $SIG{__DIE__};
-            my $compiler = do {
-                package # hide from PAUSE
-                    Eval::Closure::Sandbox;
-                eval $source;
-            };
-            my $e = $@;
-            $compiler_cache{$source} = [ $compiler, $e ];
+            $compiler_cache{$source} = _clean_eval($source);
         }
 
         return @{ $compiler_cache{$source} };
     }
 }
 
+sub _clean_eval {
+    package # hide from PAUSE
+        Eval::Closure::Sandbox;
+    local $@;
+    local $SIG{__DIE__};
+    my $compiler = eval $_[0];
+    my $e = $@;
+    return [ $compiler, $e ];
+}
+
 sub _make_compiler_source {
     my ($source, @capture_keys) = @_;
     my $i = 0;
diff --git a/t/close-over.t b/t/close-over.t
index 8a58aa3..254ec40 100644
--- a/t/close-over.t
+++ b/t/close-over.t
@@ -4,6 +4,7 @@ use warnings;
 use Test::More;
 use Test::Fatal;
 
+use B;
 use Eval::Closure;
 
 use Test::Requires 'PadWalker';
@@ -34,22 +35,38 @@ use Test::Requires 'PadWalker';
 }
 
 {
-    my $foo = [];
-    my $env = { '$foo' => \$foo };
+    # i feel dirty
+    my $c = eval_closure(source => 'sub { }');
+    my $b = B::svref_2object($c);
+    my @scopes;
+    while ($b->isa('B::CV')) {
+        push @scopes, $b;
+        $b = $b->OUTSIDE;
+    }
+    my @visible_in_outer_scope
+        = grep { $_ ne '&' }
+          map  { $_->PV }
+          grep { $_->isa('B::PV') }
+          map  { $_->PADLIST->ARRAYelt(0)->ARRAY }
+          @scopes;
 
-    like(
-        exception {
-            eval_closure(
-                source      => 'sub { push @$foo, @_; return $__captures }',
-                environment => $env,
-            );
-        },
-        qr/Global symbol "\$__captures/,
-        "we don't close over \$__captures"
-    );
-}
+    # test to ensure we don't inadvertently screw up this test by rearranging
+    # code. if the scope that encloses the eval ends up not declaring $e, then
+    # change this test.
+    ok(scalar(grep { $_ eq '$e' } @visible_in_outer_scope),
+       "visible list is sane");
 
-# it'd be nice if we could test that closing over other things wasn't possible,
-# but perl's optimizer gets in the way of that
+    for my $outer_scope_pad_entry (@visible_in_outer_scope) {
+        like(
+            exception {
+                eval_closure(
+                    source => "sub { $outer_scope_pad_entry }",
+                );
+            },
+            qr/Global symbol "\Q$outer_scope_pad_entry/,
+            "we don't close over $outer_scope_pad_entry"
+        );
+    }
+}
 
 done_testing;