Skip to content
Browse files

i always forget that B exists

  • Loading branch information...
1 parent a0e934a commit 0fb2ea464c6eb6c52831d44ef541a0d4d5c95a92 @doy committed Aug 2, 2011
Showing with 43 additions and 24 deletions.
  1. +11 −9 lib/Eval/Closure.pm
  2. +32 −15 t/close-over.t
View
20 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;
View
47 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;

0 comments on commit 0fb2ea4

Please sign in to comment.
Something went wrong with that request. Please try again.