Commit | Line | Data |
022eb0cc |
1 | use Devel::Declare (); |
2 | use Test::More qw(no_plan); |
3 | use Scope::Guard; |
4 | |
5 | { |
6 | package FoomHandlers; |
7 | |
8 | use strict; |
9 | use warnings; |
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 { |
83 | $^H |= 0x120000; |
84 | $^H{DD_FOOMHANDLERS} = Scope::Guard->new(sub { |
85 | my $linestr = Devel::Declare::get_linestr; |
86 | my $offset = Devel::Declare::get_linestr_offset; |
87 | substr($linestr, $offset, 0) = ';'; |
88 | Devel::Declare::set_linestr($linestr); |
89 | }); |
90 | } |
91 | |
92 | package Foo; |
93 | |
94 | use strict; |
95 | use warnings; |
96 | |
97 | sub foom (&) { } |
98 | |
99 | BEGIN { |
100 | Devel::Declare->setup_for( |
101 | __PACKAGE__, |
102 | { foom => { |
103 | const => \&FoomHandlers::const, |
104 | } } |
105 | ); |
106 | } |
107 | |
108 | foom { |
109 | 1; |
110 | } |
111 | |
112 | ::ok(1, 'Compiled as statement ok'); |
113 | } |