Commit | Line | Data |
460a4d15 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
01b68b64 |
5 | use Test::Fatal; |
460a4d15 |
6 | |
0fb2ea46 |
7 | use B; |
460a4d15 |
8 | use Eval::Closure; |
9 | |
10 | use Test::Requires 'PadWalker'; |
11 | |
12 | { |
13 | my $foo = []; |
14 | my $env = { '$foo' => \$foo }; |
15 | |
16 | my $code = eval_closure( |
17 | source => 'sub { push @$foo, @_ }', |
18 | environment => $env, |
19 | ); |
20 | is_deeply(scalar(PadWalker::closed_over($code)), $env, |
21 | "closed over the right things"); |
22 | } |
23 | |
24 | { |
25 | my $foo = {}; |
26 | my $bar = []; |
27 | my $env = { '$foo' => \$bar, '$bar' => \$foo }; |
28 | |
29 | my $code = eval_closure( |
30 | source => 'sub { push @$foo, @_; $bar->{foo} = \@_ }', |
31 | environment => $env, |
32 | ); |
33 | is_deeply(scalar(PadWalker::closed_over($code)), $env, |
34 | "closed over the right things"); |
35 | } |
36 | |
37 | { |
0fb2ea46 |
38 | # i feel dirty |
39 | my $c = eval_closure(source => 'sub { }'); |
40 | my $b = B::svref_2object($c); |
41 | my @scopes; |
42 | while ($b->isa('B::CV')) { |
43 | push @scopes, $b; |
44 | $b = $b->OUTSIDE; |
45 | } |
46 | my @visible_in_outer_scope |
47 | = grep { $_ ne '&' } |
48 | map { $_->PV } |
49 | grep { $_->isa('B::PV') } |
50 | map { $_->PADLIST->ARRAYelt(0)->ARRAY } |
51 | @scopes; |
460a4d15 |
52 | |
0fb2ea46 |
53 | # test to ensure we don't inadvertently screw up this test by rearranging |
54 | # code. if the scope that encloses the eval ends up not declaring $e, then |
55 | # change this test. |
56 | ok(scalar(grep { $_ eq '$e' } @visible_in_outer_scope), |
57 | "visible list is sane"); |
460a4d15 |
58 | |
0fb2ea46 |
59 | for my $outer_scope_pad_entry (@visible_in_outer_scope) { |
60 | like( |
61 | exception { |
62 | eval_closure( |
63 | source => "sub { $outer_scope_pad_entry }", |
64 | ); |
65 | }, |
66 | qr/Global symbol "\Q$outer_scope_pad_entry/, |
67 | "we don't close over $outer_scope_pad_entry" |
68 | ); |
69 | } |
70 | } |
460a4d15 |
71 | |
72 | done_testing; |