t/close-over.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Fatal;
   6
   7 use B;
   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 {
  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;
  52
  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");
  58
  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 }
  71
  72 done_testing;