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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
use strict;
use warnings;
no warnings 'once';
use Test::More;
use Test::Fatal;
use Data::Dumper;
use Sub::Quote qw(
capture_unroll
inlinify
);
my $captures = {
'$x' => \1,
'$y' => \2,
};
my $prelude = capture_unroll '$captures', $captures, 4;
{
my $sub = eval
"sub { $prelude"
. '[ $x, $y ] }';
is "$@", '', 'capture_unroll produces valid code';
is_deeply $sub->(), [ 1, 2 ], 'unrolled variables get correct values';
}
like exception {
capture_unroll '$captures', { '&foo' => \sub { 5 } }, 4;
}, qr/^capture key should start with @, % or \$/,
'capture_unroll rejects vars other than scalar, hash, or array';
{
my $inlined_code = inlinify q{
my ($x, $y) = @_;
[ $x, $y ];
}, '$x, $y', $prelude;
my $sub = eval "sub { $inlined_code }";
is "$@", '', 'inlinify produces valid code'
or diag "code:\n$inlined_code";
is_deeply $sub->(), [ 1, 2 ], 'inlinified code get correct values';
unlike $inlined_code, qr/my \(\$x, \$y\) = \@_;/,
"matching variables aren't reassigned";
}
{
$Bar::baz = 3;
my $inlined_code = inlinify q{
package Bar;
my ($x, $y) = @_;
[ $x, $y, our $baz ];
}, '$x, $y', $prelude;
my $sub = eval "sub { $inlined_code }";
is "$@", '', 'inlinify produces valid code'
or diag "code:\n$inlined_code";
is_deeply $sub->(), [ 1, 2, 3 ], 'inlinified code get correct values';
unlike $inlined_code, qr/my \(\$x, \$y\) = \@_;/,
"matching variables aren't reassigned";
}
{
my $inlined_code = inlinify q{
my ($d, $f) = @_;
[ $d, $f ];
}, '$x, $y', $prelude;
my $sub = eval "sub { $inlined_code }";
is "$@", '', 'inlinify with unmatched params produces valid code'
or diag "code:\n$inlined_code";
is_deeply $sub->(), [ 1, 2 ], 'inlinified code get correct values';
}
{
my $inlined_code = inlinify q{
my $z = $_[0];
$z;
}, '$y', $prelude;
my $sub = eval "sub { $inlined_code }";
is "$@", '', 'inlinify with out @_ produces valid code'
or diag "code:\n$inlined_code";
is $sub->(), 2, 'inlinified code get correct values';
}
{
my $inlined_code = inlinify q{
my $z = $_[0];
$z;
}, '@_', $prelude;
my $sub = eval "sub { $inlined_code }";
is "$@", '', 'inlinify with @_ as args produces valid code'
or diag "code:\n$inlined_code";
is $sub->(5), 5, 'inlinified code get correct values';
}
{
my $inlined_code = inlinify q{
my $z = $_[0];
$z;
}, '$x', $prelude, 1;
my $sub = eval "sub { [ $inlined_code, \@_ ] }";
is "$@", '', 'inlinify with local produces valid code'
or diag "code:\n$inlined_code";
is_deeply $sub->(5), [1, 5], 'inlinified code get correct values';
}
{
my $inlined_code = inlinify q{
219;
}, undef, $prelude;
my $sub = eval "sub { $inlined_code }";
is "$@", '', 'inlinify without args produces valid code'
or diag "code:\n$inlined_code";
is $sub->(), 219, 'inlinified code get correct values';
}
{
my $inlined_code = inlinify q{
219;
}, '@_', undef;
my $sub = eval "sub { $inlined_code }";
is "$@", '', 'inlinify without extra produces valid code'
or diag "code:\n$inlined_code";
is $sub->(), 219, 'inlinified code get correct values';
}
done_testing;
|
