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
|
use strictures 1;
use Test::More;
use Test::Fatal;
use Sub::Quote;
our %EVALED;
my $one = quote_sub q{
BEGIN { $::EVALED{'one'} = 1 }
42
};
my $two = quote_sub q{
BEGIN { $::EVALED{'two'} = 1 }
3 + $x++
} => { '$x' => \do { my $x = 0 } };
ok(!keys %EVALED, 'Nothing evaled yet');
my $u_one = unquote_sub $one;
is_deeply(
[ sort keys %EVALED ], [ qw(one) ],
'subs one evaled'
);
is($one->(), 42, 'One (quoted version)');
is($u_one->(), 42, 'One (unquoted version)');
is($two->(), 3, 'Two (quoted version)');
is(unquote_sub($two)->(), 4, 'Two (unquoted version)');
is($two->(), 5, 'Two (quoted version again)');
my $three = quote_sub 'Foo::three' => q{
$x = $_[1] if $_[1];
die +(caller(0))[3] if @_ > 2;
return $x;
} => { '$x' => \do { my $x = 'spoon' } };
is(Foo->three, 'spoon', 'get ok (named method)');
is(Foo->three('fork'), 'fork', 'set ok (named method)');
is(Foo->three, 'fork', 're-get ok (named method)');
like(
exception { Foo->three(qw(full cutlery set)) }, qr/Foo::three/,
'exception contains correct name'
);
done_testing;
|
