File: | /tmp/automake/lib/Automake/Location.pm |
Coverage: | 72.4% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # Copyright (C) 2002, 2003, 2008, 2009 Free Software Foundation, Inc. | ||||||
2 | |||||||
3 | # This program is free software; you can redistribute it and/or modify | ||||||
4 | # it under the terms of the GNU General Public License as published by | ||||||
5 | # the Free Software Foundation; either version 2, or (at your option) | ||||||
6 | # any later version. | ||||||
7 | |||||||
8 | # This program is distributed in the hope that it will be useful, | ||||||
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||||
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||||
11 | # GNU General Public License for more details. | ||||||
12 | |||||||
13 | # You should have received a copy of the GNU General Public License | ||||||
14 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | ||||||
15 | |||||||
16 | package Automake::Location; | ||||||
17 | |||||||
18 - 85 | =head1 NAME Automake::Location - a class for location tracking, with a stack of contexts =head1 SYNOPSIS use Automake::Location; # Create a new Location object my $where = new Automake::Location "foo.c:13"; # Change the location $where->set ("foo.c:14"); # Get the location (without context). # Here this should print "foo.c:14" print $where->get, "\n"; # Push a context, and change the location $where->push_context ("included from here"); $where->set ("bar.h:1"); # Print the location and the stack of context (for debugging) print $where->dump; # This should display # bar.h:1: # foo.c:14: included from here # Get the contexts (list of [$location_string, $description]) for my $pair (reverse $where->contexts) { my ($loc, $descr) = @{$pair}; ... } # Pop a context, and reset the location to the previous context. $where->pop_context; # Clone a Location. Use this when storing the state of a location # that would otherwise be modified. my $where_copy = $where->clone; # Serialize a Location object (for passing through a thread queue, # for example) my @array = $where->serialize (); # De-serialize: recreate a Location object from a queue. my $where = new Automake::Location::deserialize ($queue); =head1 DESCRIPTION C<Location> objects are used to keep track of locations in Automake, and used to produce diagnostics. A C<Location> object is made of two parts: a location string, and a stack of contexts. For instance if C<VAR> is defined at line 1 in F<bar.h> which was included at line 14 in F<foo.c>, then the location string should be C<"bar.h:10"> and the context should be the pair (C<"foo.c:14">, C<"included from here">). Section I<SYNOPSIS> shows how to setup such a C<Location>, and access the location string or the stack of contexts. You can pass a C<Location> to C<Automake::Channels::msg>. =cut | ||||||
86 | |||||||
87 - 95 | =head2 Methods =over =item C<$where = new Automake::Location ([$position])> Create and return a new Location object. =cut | ||||||
96 | |||||||
97 | sub new ($;$) | ||||||
98 | { | ||||||
99 | 424710 | 1 | 679114 | my ($class, $position) = @_; | |||
100 | 424710 | 1171045 | my $self = { | ||||
101 | position => $position, | ||||||
102 | contexts => [], | ||||||
103 | }; | ||||||
104 | 424710 | 782352 | bless $self, $class; | ||||
105 | 424710 | 743248 | return $self; | ||||
106 | } | ||||||
107 | |||||||
108 - 112 | =item C<$location-E<gt>set ($position)> Change the location to be C<$position>. =cut | ||||||
113 | |||||||
114 | sub set ($$) | ||||||
115 | { | ||||||
116 | 645569 | 1 | 1026072 | my ($self, $position) = @_; | |||
117 | 645569 | 1353427 | $self->{'position'} = $position; | ||||
118 | } | ||||||
119 | |||||||
120 - 124 | =item C<$location-E<gt>get> Get the location (without context). =cut | ||||||
125 | |||||||
126 | sub get ($) | ||||||
127 | { | ||||||
128 | 303308 | 1 | 393712 | my ($self) = @_; | |||
129 | 303308 | 850071 | return $self->{'position'}; | ||||
130 | } | ||||||
131 | |||||||
132 - 136 | =item C<$location-E<gt>push_context ($context)> Push a context to the location. =cut | ||||||
137 | |||||||
138 | sub push_context ($$) | ||||||
139 | { | ||||||
140 | 4170 | 1 | 8610 | my ($self, $context) = @_; | |||
141 | 4170 4170 | 4699 11790 | push @{$self->{'contexts'}}, [$self->get, $context]; | ||||
142 | 4170 | 9159 | $self->set (undef); | ||||
143 | } | ||||||
144 | |||||||
145 - 149 | =item C<$where = $location-E<gt>pop_context ($context)> Pop a context, and reset the location to the previous context. =cut | ||||||
150 | |||||||
151 | sub pop_context ($) | ||||||
152 | { | ||||||
153 | 1376 | 1 | 2551 | my ($self) = @_; | |||
154 | 1376 1376 | 1633 3136 | my $pair = pop @{$self->{'contexts'}}; | ||||
155 | 1376 | 3376 | $self->set ($pair->[0]); | ||||
156 | 1376 1376 | 1624 2899 | return @{$pair}; | ||||
157 | } | ||||||
158 | |||||||
159 - 163 | =item C<@contexts = $location-E<gt>get_contexts> Return the array of contexts. =cut | ||||||
164 | |||||||
165 | sub get_contexts ($) | ||||||
166 | { | ||||||
167 | 295433 | 1 | 395892 | my ($self) = @_; | |||
168 | 295433 295433 | 275230 639919 | return @{$self->{'contexts'}}; | ||||
169 | } | ||||||
170 | |||||||
171 - 176 | =item C<$location = $location-E<gt>clone> Clone a Location. Use this when storing the state of a location that would otherwise be modified. =cut | ||||||
177 | |||||||
178 | sub clone ($) | ||||||
179 | { | ||||||
180 | 294988 | 1 | 412343 | my ($self) = @_; | |||
181 | 294988 | 498155 | my $other = new Automake::Location ($self->get); | ||||
182 | 294988 | 573747 | my @contexts = $self->get_contexts; | ||||
183 | 294988 | 478796 | for my $pair (@contexts) | ||||
184 | { | ||||||
185 | 14798 14798 14798 | 15161 23985 44259 | push @{$other->{'contexts'}}, [@{$pair}]; | ||||
186 | } | ||||||
187 | 294988 | 974603 | return $other; | ||||
188 | } | ||||||
189 | |||||||
190 - 194 | =item C<$res = $location-E<gt>dump> Print the location and the stack of context (for debugging). =cut | ||||||
195 | |||||||
196 | sub dump ($) | ||||||
197 | { | ||||||
198 | 37 | 1 | 72 | my ($self) = @_; | |||
199 | 37 | 85 | my $res = ($self->get || 'INTERNAL') . ":\n"; | ||||
200 | 37 | 94 | for my $pair (reverse $self->get_contexts) | ||||
201 | { | ||||||
202 | 8 | 20 | $res .= $pair->[0] || 'INTERNAL'; | ||||
203 | 8 | 21 | $res .= ": $pair->[1]\n"; | ||||
204 | } | ||||||
205 | 37 | 101 | return $res; | ||||
206 | } | ||||||
207 | |||||||
208 - 213 | =item C<@array = $location-E<gt>serialize> Serialize a Location object (for passing through a thread queue, for example). =cut | ||||||
214 | |||||||
215 | sub serialize ($) | ||||||
216 | { | ||||||
217 | 0 | 1 | my ($self) = @_; | ||||
218 | 0 | my @serial = (); | |||||
219 | 0 | push @serial, $self->get; | |||||
220 | 0 | my @contexts = $self->get_contexts; | |||||
221 | 0 | for my $pair (@contexts) | |||||
222 | { | ||||||
223 | 0 0 | push @serial, @{$pair}; | |||||
224 | } | ||||||
225 | 0 | push @serial, undef; | |||||
226 | 0 | return @serial; | |||||
227 | } | ||||||
228 | |||||||
229 - 233 | =item C<new Automake::Location::deserialize ($queue)> De-serialize: recreate a Location object from a queue. =cut | ||||||
234 | |||||||
235 | sub deserialize ($) | ||||||
236 | { | ||||||
237 | 0 | 1 | my ($queue) = @_; | ||||
238 | 0 | my $position = $queue->dequeue (); | |||||
239 | 0 | my $self = new Automake::Location $position; | |||||
240 | 0 | while (my $position = $queue->dequeue ()) | |||||
241 | { | ||||||
242 | 0 | my $context = $queue->dequeue (); | |||||
243 | 0 0 | push @{$self->{'contexts'}}, [$position, $context]; | |||||
244 | } | ||||||
245 | 0 | return $self; | |||||
246 | } | ||||||
247 | |||||||
248 | =back | ||||||
249 | |||||||
250 - 258 | =head1 SEE ALSO L<Automake::Channels> =head1 HISTORY Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>. =cut | ||||||
259 | |||||||
260 | 1; | ||||||
261 | |||||||
262 | ### Setup "GNU" style for perl-mode and cperl-mode. | ||||||
263 | ## Local Variables: | ||||||
264 | ## perl-indent-level: 2 | ||||||
265 | ## perl-continued-statement-offset: 2 | ||||||
266 | ## perl-continued-brace-offset: 0 | ||||||
267 | ## perl-brace-offset: 0 | ||||||
268 | ## perl-brace-imaginary-offset: 0 | ||||||
269 | ## perl-label-offset: -2 | ||||||
270 | ## cperl-indent-level: 2 | ||||||
271 | ## cperl-brace-offset: 0 | ||||||
272 | ## cperl-continued-brace-offset: 0 | ||||||
273 | ## cperl-label-offset: -2 | ||||||
274 | ## cperl-extra-newline-before-brace: t | ||||||
275 | ## cperl-merge-trailing-else: nil | ||||||
276 | ## cperl-continued-statement-offset: 2 | ||||||
277 | ## End: |