Commit | Line | Data |
3e812111 |
1 | use strict; |
2 | use warnings; |
361de2b5 |
3 | use Test::More tests => 20; |
3e812111 |
4 | |
5 | # This test script is derived from a MooseX::Method::Signatures test, |
6 | # which is sensitive to some details of Devel::Declare behaviour that |
7 | # ctx-simple.t is not. In particular, the use of a paren immediately |
8 | # following the declarator, constructing a parenthesised function call, |
9 | # invokes a different parser path. |
10 | |
11 | use Devel::Declare (); |
12 | use Devel::Declare::Context::Simple (); |
13 | use B::Hooks::EndOfScope qw(on_scope_end); |
14 | |
15 | sub inject_after_scope($) { |
16 | my ($inject) = @_; |
17 | on_scope_end { |
18 | my $line = Devel::Declare::get_linestr(); |
19 | return unless defined $line; |
20 | my $offset = Devel::Declare::get_linestr_offset(); |
21 | substr($line, $offset, 0) = $inject; |
22 | Devel::Declare::set_linestr($line); |
23 | }; |
24 | } |
25 | |
26 | sub mtfnpy_parser(@) { |
27 | my $ctx = Devel::Declare::Context::Simple->new(into => __PACKAGE__); |
28 | $ctx->init(@_); |
29 | $ctx->skip_declarator; |
30 | my $name = $ctx->strip_name; |
31 | die "No name\n" unless defined $name; |
32 | my $proto = $ctx->strip_proto; |
33 | die "Wrong declarator\n" unless $ctx->declarator eq "mtfnpy"; |
361de2b5 |
34 | $proto =~ s/\n/\\n/g; |
3e812111 |
35 | $ctx->inject_if_block(qq[BEGIN { @{[__PACKAGE__]}::inject_after_scope(', q[${name}]);') } unshift \@_, "${proto}";], "(sub "); |
36 | my $compile_stash = $ctx->get_curstash_name; |
37 | $ctx->shadow(sub { |
38 | my ($code, $name, @args) = @_; |
39 | no strict "refs"; |
40 | *{"${compile_stash}::${name}"} = $code; |
41 | }); |
42 | } |
43 | |
44 | BEGIN { |
45 | Devel::Declare->setup_for(__PACKAGE__, { |
46 | mtfnpy => { const => \&mtfnpy_parser }, |
47 | }); |
48 | *mtfnpy = sub {}; |
49 | } |
50 | |
51 | mtfnpy foo (extra) { |
52 | is scalar(@_), 4; |
53 | is $_[0], "extra"; |
54 | is $_[1], "a"; |
55 | is $_[2], "b"; |
56 | is $_[3], "c"; |
57 | } |
58 | |
59 | foo(qw(a b c)); |
60 | |
361de2b5 |
61 | mtfnpy bar (ex |
62 | tra) { |
63 | is scalar(@_), 4; |
64 | is $_[0], "ex\ntra"; |
65 | is $_[1], "a"; |
66 | is $_[2], "b"; |
67 | is $_[3], "c"; |
68 | } |
69 | |
70 | bar(qw(a b c)); |
71 | |
72 | mtfnpy baz (ex |
73 | tra extra extra) { |
74 | is scalar(@_), 4; |
75 | is $_[0], "ex\ntra extra extra"; |
76 | is $_[1], "a"; |
77 | is $_[2], "b"; |
78 | is $_[3], "c"; |
79 | } |
80 | |
81 | baz(qw(a b c)); |
82 | |
83 | mtfnpy quux (ex |
84 | tra |
85 | extra) { |
86 | is scalar(@_), 4; |
87 | is $_[0], "ex\ntra\nextra"; |
88 | is $_[1], "a"; |
89 | is $_[2], "b"; |
90 | is $_[3], "c"; |
91 | } |
92 | |
93 | quux(qw(a b c)); |
94 | |
3e812111 |
95 | 1; |