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