Commit | Line | Data |
022eb0cc |
1 | use Devel::Declare (); |
2 | use Test::More qw(no_plan); |
022eb0cc |
3 | |
4 | { |
5 | package FoomHandlers; |
6 | |
7 | use strict; |
8 | use warnings; |
b9a35c84 |
9 | use B::Hooks::EndOfScope; |
022eb0cc |
10 | |
11 | our ($Declarator, $Offset); |
12 | |
13 | sub skip_declarator { |
14 | $Offset += Devel::Declare::toke_move_past_token($Offset); |
15 | } |
16 | |
17 | sub skipspace { |
18 | $Offset += Devel::Declare::toke_skipspace($Offset); |
19 | } |
20 | |
21 | sub strip_name { |
22 | skipspace; |
23 | if (my $len = Devel::Declare::toke_scan_word($Offset, 1)) { |
24 | my $linestr = Devel::Declare::get_linestr(); |
25 | my $name = substr($linestr, $Offset, $len); |
26 | substr($linestr, $Offset, $len) = ''; |
27 | Devel::Declare::set_linestr($linestr); |
28 | return $name; |
29 | } |
30 | return; |
31 | } |
32 | |
33 | sub strip_proto { |
34 | skipspace; |
35 | |
36 | my $linestr = Devel::Declare::get_linestr(); |
37 | if (substr($linestr, $Offset, 1) eq '(') { |
38 | my $length = Devel::Declare::toke_scan_str($Offset); |
39 | my $proto = Devel::Declare::get_lex_stuff(); |
40 | Devel::Declare::clear_lex_stuff(); |
41 | $linestr = Devel::Declare::get_linestr(); |
42 | substr($linestr, $Offset, $length) = ''; |
43 | Devel::Declare::set_linestr($linestr); |
44 | return $proto; |
45 | } |
46 | return; |
47 | } |
48 | |
49 | sub shadow { |
50 | my $pack = Devel::Declare::get_curstash_name; |
51 | Devel::Declare::shadow_sub("${pack}::${Declarator}", $_[0]); |
52 | } |
53 | |
54 | sub inject_str { |
55 | my $linestr = Devel::Declare::get_linestr; |
56 | substr($linestr, $Offset, 0) = $_[0]; |
57 | Devel::Declare::set_linestr($linestr); |
58 | } |
59 | |
60 | sub strip_str { |
61 | my $linestr = Devel::Declare::get_linestr; |
62 | if (substr($linestr, $Offset, length($_[0])) eq $_[0]) { |
63 | substr($linestr, $Offset, length($_[0])) = ''; |
64 | Devel::Declare::set_linestr($linestr); |
65 | return 1; |
66 | } |
67 | return 0; |
68 | } |
69 | |
70 | sub const { |
71 | local ($Declarator, $Offset) = @_; |
72 | skip_declarator; |
73 | skipspace; |
74 | my $linestr = Devel::Declare::get_linestr; |
75 | if (substr($linestr, $Offset, 1) eq '{') { |
76 | substr($linestr, $Offset+1, 0) = ' BEGIN { FoomHandlers::inject_scope }; '; |
77 | Devel::Declare::set_linestr($linestr); |
78 | } |
79 | shadow(sub (&) { "foom?" }); |
80 | } |
81 | |
82 | sub inject_scope { |
b9a35c84 |
83 | on_scope_end { |
022eb0cc |
84 | my $linestr = Devel::Declare::get_linestr; |
85 | my $offset = Devel::Declare::get_linestr_offset; |
86 | substr($linestr, $offset, 0) = ';'; |
87 | Devel::Declare::set_linestr($linestr); |
b9a35c84 |
88 | }; |
022eb0cc |
89 | } |
90 | |
91 | package Foo; |
92 | |
93 | use strict; |
94 | use warnings; |
95 | |
96 | sub foom (&) { } |
97 | |
98 | BEGIN { |
99 | Devel::Declare->setup_for( |
100 | __PACKAGE__, |
101 | { foom => { |
102 | const => \&FoomHandlers::const, |
103 | } } |
104 | ); |
105 | } |
106 | |
107 | foom { |
108 | 1; |
109 | } |
110 | |
111 | ::ok(1, 'Compiled as statement ok'); |
112 | } |