File: close-over.t

package info (click to toggle)
libeval-closure-perl 0.14-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, buster, sid, stretch
  • size: 196 kB
  • ctags: 12
  • sloc: perl: 559; makefile: 2
file content (72 lines) | stat: -rw-r--r-- 1,820 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Test::Fatal;

use B;
use Eval::Closure;

use Test::Requires 'PadWalker';

{
    my $foo = [];
    my $env = { '$foo' => \$foo };

    my $code = eval_closure(
        source      => 'sub { push @$foo, @_ }',
        environment => $env,
    );
    is_deeply(scalar(PadWalker::closed_over($code)), $env,
              "closed over the right things");
}

{
    my $foo = {};
    my $bar = [];
    my $env = { '$foo' => \$bar, '$bar' => \$foo };

    my $code = eval_closure(
        source      => 'sub { push @$foo, @_; $bar->{foo} = \@_ }',
        environment => $env,
    );
    is_deeply(scalar(PadWalker::closed_over($code)), $env,
              "closed over the right things");
}

{
    # 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 { defined && length && $_ ne '&' }
          map  { $_->PV }
          grep { $_->can('PV') }
          map  { $_->PADLIST->ARRAYelt(0)->ARRAY }
          @scopes;

    # 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");

    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;