File: | /usr/local/share/automake-1.11/Automake/Location.pm |
Coverage: | 6.6% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # Copyright (C) 2002, 2003, 2008 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 from 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 | sub new ($;$) | ||||||
88 | { | ||||||
89 | 2 | 0 | 6 | my ($class, $position) = @_; | |||
90 | 2 | 10 | my $self = { | ||||
91 | position => $position, | ||||||
92 | contexts => [], | ||||||
93 | }; | ||||||
94 | 2 | 17 | bless $self, $class; | ||||
95 | 2 | 6 | return $self; | ||||
96 | } | ||||||
97 | |||||||
98 | sub set ($$) | ||||||
99 | { | ||||||
100 | 0 | 0 | my ($self, $position) = @_; | ||||
101 | 0 | $self->{'position'} = $position; | |||||
102 | } | ||||||
103 | |||||||
104 | sub get ($) | ||||||
105 | { | ||||||
106 | 0 | 0 | my ($self) = @_; | ||||
107 | 0 | return $self->{'position'}; | |||||
108 | } | ||||||
109 | |||||||
110 | sub push_context ($$) | ||||||
111 | { | ||||||
112 | 0 | 0 | my ($self, $context) = @_; | ||||
113 | 0 0 | push @{$self->{'contexts'}}, [$self->get, $context]; | |||||
114 | 0 | $self->set (undef); | |||||
115 | } | ||||||
116 | |||||||
117 | sub pop_context ($) | ||||||
118 | { | ||||||
119 | 0 | 0 | my ($self) = @_; | ||||
120 | 0 0 | my $pair = pop @{$self->{'contexts'}}; | |||||
121 | 0 | $self->set ($pair->[0]); | |||||
122 | 0 0 | return @{$pair}; | |||||
123 | } | ||||||
124 | |||||||
125 | sub get_contexts ($) | ||||||
126 | { | ||||||
127 | 0 | 0 | my ($self) = @_; | ||||
128 | 0 0 | return @{$self->{'contexts'}}; | |||||
129 | } | ||||||
130 | |||||||
131 | sub clone ($) | ||||||
132 | { | ||||||
133 | 0 | 0 | my ($self) = @_; | ||||
134 | 0 | my $other = new Automake::Location ($self->get); | |||||
135 | 0 | my @contexts = $self->get_contexts; | |||||
136 | 0 | for my $pair (@contexts) | |||||
137 | { | ||||||
138 | 0 0 0 | push @{$other->{'contexts'}}, [@{$pair}]; | |||||
139 | } | ||||||
140 | 0 | return $other; | |||||
141 | } | ||||||
142 | |||||||
143 | sub dump ($) | ||||||
144 | { | ||||||
145 | 0 | 0 | my ($self) = @_; | ||||
146 | 0 | my $res = ($self->get || 'INTERNAL') . ":\n"; | |||||
147 | 0 | for my $pair (reverse $self->get_contexts) | |||||
148 | { | ||||||
149 | 0 | $res .= $pair->[0] || 'INTERNAL'; | |||||
150 | 0 | $res .= ": $pair->[1]\n"; | |||||
151 | } | ||||||
152 | 0 | return $res; | |||||
153 | } | ||||||
154 | |||||||
155 | sub serialize ($) | ||||||
156 | { | ||||||
157 | 0 | 0 | my ($self) = @_; | ||||
158 | 0 | my @serial = (); | |||||
159 | 0 | push @serial, $self->get; | |||||
160 | 0 | my @contexts = $self->get_contexts; | |||||
161 | 0 | for my $pair (@contexts) | |||||
162 | { | ||||||
163 | 0 0 | push @serial, @{$pair}; | |||||
164 | } | ||||||
165 | 0 | push @serial, undef; | |||||
166 | 0 | return @serial; | |||||
167 | } | ||||||
168 | |||||||
169 | sub deserialize ($) | ||||||
170 | { | ||||||
171 | 0 | 0 | my ($queue) = @_; | ||||
172 | 0 | my $position = $queue->dequeue (); | |||||
173 | 0 | my $self = new Automake::Location $position; | |||||
174 | 0 | while (my $position = $queue->dequeue ()) | |||||
175 | { | ||||||
176 | 0 | my $context = $queue->dequeue (); | |||||
177 | 0 0 | push @{$self->{'contexts'}}, [$position, $context]; | |||||
178 | } | ||||||
179 | 0 | return $self; | |||||
180 | } | ||||||
181 | |||||||
182 - 190 | =head1 SEE ALSO L<Automake::Channels> =head1 HISTORY Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>. =cut | ||||||
191 | |||||||
192 | 1; | ||||||
193 | |||||||
194 | ### Setup "GNU" style for perl-mode and cperl-mode. | ||||||
195 | ## Local Variables: | ||||||
196 | ## perl-indent-level: 2 | ||||||
197 | ## perl-continued-statement-offset: 2 | ||||||
198 | ## perl-continued-brace-offset: 0 | ||||||
199 | ## perl-brace-offset: 0 | ||||||
200 | ## perl-brace-imaginary-offset: 0 | ||||||
201 | ## perl-label-offset: -2 | ||||||
202 | ## cperl-indent-level: 2 | ||||||
203 | ## cperl-brace-offset: 0 | ||||||
204 | ## cperl-continued-brace-offset: 0 | ||||||
205 | ## cperl-label-offset: -2 | ||||||
206 | ## cperl-extra-newline-before-brace: t | ||||||
207 | ## cperl-merge-trailing-else: nil | ||||||
208 | ## cperl-continued-statement-offset: 2 | ||||||
209 | ## End: |