Commit | Line | Data |
3e812111 |
1 | use strict; |
2 | use warnings; |
3 | use Test::More tests => 5; |
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"; |
34 | $ctx->inject_if_block(qq[BEGIN { @{[__PACKAGE__]}::inject_after_scope(', q[${name}]);') } unshift \@_, "${proto}";], "(sub "); |
35 | my $compile_stash = $ctx->get_curstash_name; |
36 | $ctx->shadow(sub { |
37 | my ($code, $name, @args) = @_; |
38 | no strict "refs"; |
39 | *{"${compile_stash}::${name}"} = $code; |
40 | }); |
41 | } |
42 | |
43 | BEGIN { |
44 | Devel::Declare->setup_for(__PACKAGE__, { |
45 | mtfnpy => { const => \&mtfnpy_parser }, |
46 | }); |
47 | *mtfnpy = sub {}; |
48 | } |
49 | |
50 | mtfnpy foo (extra) { |
51 | is scalar(@_), 4; |
52 | is $_[0], "extra"; |
53 | is $_[1], "a"; |
54 | is $_[2], "b"; |
55 | is $_[3], "c"; |
56 | } |
57 | |
58 | foo(qw(a b c)); |
59 | |
60 | 1; |