File Coverage

blib/lib/MarpaX/Languages/C/AST/Scope.pm
Criterion Covered Total %
statement 68 110 61.8
branch 12 42 28.5
condition 2 15 13.3
subroutine 15 22 68.1
pod 17 17 100.0
total 114 206 55.3


line stmt bran cond sub pod time code
1 2     2   9 use strict;
  2         3  
  2         72  
2 2     2   7 use warnings FATAL => 'all';
  2         3  
  2         100  
3              
4             package MarpaX::Languages::C::AST::Scope;
5 2     2   9 use MarpaX::Languages::C::AST::Util qw/whoami/;
  2         3  
  2         91  
6              
7             # ABSTRACT: Scope management when translating a C source to an AST
8              
9 2     2   7 use Log::Any qw/$log/;
  2         4  
  2         10  
10 2     2   111 use Carp qw/croak/;
  2         4  
  2         1910  
11              
12             our $VERSION = '0.45'; # VERSION
13              
14              
15             sub new {
16 1     1 1 2 my ($class) = @_;
17              
18 1         9 my $self = {
19             _nscope => 0,
20             _typedefPerScope => [ {} ],
21             _enumAnyScope => {},
22             _delay => [],
23             _enterScopeCallback => [],
24             _exitScopeCallback => [],
25             };
26 1         2 bless($self, $class);
27              
28 1         14 return $self;
29             }
30              
31              
32             sub typedefPerScope {
33 0     0 1 0 my ($self) = @_;
34              
35 0         0 return $self->{_typedefPerScope};
36             }
37              
38              
39             sub enumAnyScope {
40 0     0 1 0 my ($self) = @_;
41              
42 0         0 return $self->{_enumAnyScope};
43             }
44              
45              
46             sub parseEnterScope {
47 1     1 1 1 my ($self) = @_;
48              
49             # $self->condExitScope();
50              
51 1 50       4 if ($log->is_debug) {
52 0         0 $log->debugf('[%s] Duplicating scope %d to %d', whoami(__PACKAGE__), $self->{_nscope}, $self->{_nscope} + 1);
53             }
54             #
55             # calling Clone::clone is overhead for us:
56             # - user data associated to a typedef is assumed to never be modified: copying the $data itself (i.e. usually a reference) is enough
57             # - We just want to make sure this is a new hash, the values inside the hash can remain identical
58             #
59             # Doing \%{$...} is just to make sure this is a new hash instance, with keys pointing to the same values as the origin
60             #
61 1         4 push(@{$self->{_typedefPerScope}}, \%{$self->{_typedefPerScope}->[$self->{_nscope}]});
  1         2  
  1         4  
62 1         5 push(@{$self->{_delay}}, 0);
  1         3  
63 1         2 $self->{_nscope}++;
64              
65 1 50       1 if (@{$self->{_enterScopeCallback}}) {
  1         4  
66 1         1 my ($ref, @args) = @{$self->{_enterScopeCallback}};
  1         3  
67 1         5 &$ref(@args);
68             }
69              
70             }
71              
72              
73             sub parseDelay {
74 15     15 1 16 my $self = shift;
75 15 100       28 if (@_) {
76 3         3 my $value = shift;
77 3 50       8 if ($log->is_debug) {
78 0         0 $log->debugf('[%s] Setting delay flag to %d at scope %d', whoami(__PACKAGE__), $value, $self->{_nscope});
79             }
80 3         14 $self->{_delay}->[-1] = $value;
81             }
82 15         68 return $self->{_delay}->[-1];
83             }
84              
85              
86             sub parseScopeLevel {
87 23     23 1 26 my ($self) = @_;
88              
89 23         104 return $self->{_nscope};
90             }
91              
92              
93             sub parseEnterScopeCallback {
94 1     1 1 14 my ($self, $ref, @args) = @_;
95              
96 1         18 $self->{_enterScopeCallback} = [ $ref, @args ];
97             }
98              
99              
100             sub parseExitScopeCallback {
101 1     1 1 10 my ($self, $ref, @args) = @_;
102              
103 1         5 $self->{_exitScopeCallback} = [ $ref, @args ];
104             }
105              
106              
107             sub parseExitScope {
108 2     2 1 3 my ($self, $now) = @_;
109 2   50     6 $now //= 0;
110              
111 2 50       6 if ($now) {
112 0         0 $self->doExitScope();
113             } else {
114 2         5 $self->parseDelay(1);
115             }
116             }
117              
118              
119             sub parseReenterScope {
120 1     1 1 6 my ($self) = @_;
121              
122 1 50       4 if ($log->is_debug) {
123 0         0 $log->debugf('[%s] Reenter scope at scope %d', whoami(__PACKAGE__), $self->{_nscope});
124             }
125 1         6 $self->parseDelay(0);
126              
127             }
128              
129              
130             sub condExitScope {
131 0     0 1 0 my ($self) = @_;
132              
133 0 0       0 if ($self->parseDelay) {
134 0         0 $self->doExitScope();
135             }
136             }
137              
138              
139             sub doExitScope {
140 1     1 1 2 my ($self) = @_;
141              
142 1 50       4 if ($log->is_debug) {
143 0         0 $log->debugf('[%s] Removing scope %d', whoami(__PACKAGE__), $self->{_nscope});
144             }
145 1         4 pop(@{$self->{_typedefPerScope}});
  1         3  
146 1         2 pop(@{$self->{_delay}});
  1         2  
147 1         2 $self->{_nscope}--;
148              
149 1 50       2 if (@{$self->{_exitScopeCallback}}) {
  1         4  
150 1         2 my ($ref, @args) = @{$self->{_exitScopeCallback}};
  1         3  
151 1         4 &$ref(@args);
152             }
153              
154 1 50       6 if ($self->{_nscope} > 0) {
155             #
156             # If the parent scope was marked delayed, we close it as well:
157             #
158 0 0       0 if ($self->parseDelay) {
159 0 0       0 if ($log->is_debug) {
160 0         0 $log->debugf('[%s] Parent scope has delay flag on', whoami(__PACKAGE__));
161             }
162 0         0 $self->doExitScope;
163             } else {
164 0         0 $self->parseDelay(0);
165             }
166             }
167             }
168              
169              
170             sub parseEnterTypedef {
171 0     0 1 0 my ($self, $token, $data) = @_;
172              
173 0   0     0 $data //= 1;
174              
175 0         0 $self->{_typedefPerScope}->[$self->{_nscope}]->{$token} = $data;
176              
177 0 0       0 if ($log->is_debug) {
178 0         0 $log->debugf('[%s] "%s" typedef entered at scope %d', whoami(__PACKAGE__), $token, $self->{_nscope});
179             }
180             }
181              
182              
183             sub parseEnterEnum {
184 0     0 1 0 my ($self, $token, $data) = @_;
185              
186 0   0     0 $data //= 1;
187              
188 0         0 $self->{_enumAnyScope}->{$token} = $data;
189 0 0       0 if ($log->is_debug) {
190 0         0 $log->debugf('[%s] "%s" enum entered at scope %d', whoami(__PACKAGE__), $token, $self->{_nscope});
191             }
192             #
193             # Enum wins from now on and forever
194             #
195 0         0 foreach (0..$#{$self->{_typedefPerScope}}) {
  0         0  
196 0         0 $self->parseObscureTypedef($token, $_);
197             }
198             }
199              
200              
201             sub parseObscureTypedef {
202 0     0 1 0 my ($self, $token, $scope) = @_;
203              
204 0   0     0 $scope //= $self->{_nscope};
205 0         0 $self->{_typedefPerScope}->[$scope]->{$token} = undef;
206              
207 0 0       0 if ($log->is_debug) {
208 0         0 $log->debugf('[%s] "%s" eventual typedef obscured at scope %d', whoami(__PACKAGE__), $token, $scope);
209             }
210             }
211              
212              
213             sub parseIsTypedef {
214 0     0 1 0 my ($self, $token) = @_;
215              
216 0         0 my $scope = $self->{_nscope};
217 0 0 0     0 my $rc = (exists($self->{_typedefPerScope}->[$scope]->{$token}) && defined($self->{_typedefPerScope}->[$scope]->{$token})) ? 1 : 0;
218              
219 0 0       0 if ($log->is_debug) {
220 0 0       0 $log->debugf('[%s] "%s" at scope %d is a typedef? %s', whoami(__PACKAGE__), $token, $scope, $rc ? 'yes' : 'no');
221             }
222              
223 0         0 return($rc);
224             }
225              
226              
227             sub parseIsEnum {
228 2     2 1 2 my ($self, $token) = @_;
229              
230 2 50 33     9 my $rc = (exists($self->{_enumAnyScope}->{$token}) && $self->{_enumAnyScope}->{$token}) ? 1 : 0;
231              
232 2 50       7 if ($log->is_debug) {
233 0 0       0 $log->debugf('[%s] "%s" is an enum at scope %d? %s', whoami(__PACKAGE__), $token, $self->{_nscope}, $rc ? 'yes' : 'no');
234             }
235              
236 2         16 return($rc);
237             }
238              
239             1;
240              
241             __END__