2
0

Location.pm 5.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279
  1. # Copyright (C) 2002-2017 Free Software Foundation, Inc.
  2. # This program is free software; you can redistribute it and/or modify
  3. # it under the terms of the GNU General Public License as published by
  4. # the Free Software Foundation; either version 2, or (at your option)
  5. # any later version.
  6. # This program is distributed in the hope that it will be useful,
  7. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  9. # GNU General Public License for more details.
  10. # You should have received a copy of the GNU General Public License
  11. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  12. package Automake::Location;
  13. use 5.006;
  14. =head1 NAME
  15. Automake::Location - a class for location tracking, with a stack of contexts
  16. =head1 SYNOPSIS
  17. use Automake::Location;
  18. # Create a new Location object
  19. my $where = new Automake::Location "foo.c:13";
  20. # Change the location
  21. $where->set ("foo.c:14");
  22. # Get the location (without context).
  23. # Here this should print "foo.c:14"
  24. print $where->get, "\n";
  25. # Push a context, and change the location
  26. $where->push_context ("included from here");
  27. $where->set ("bar.h:1");
  28. # Print the location and the stack of context (for debugging)
  29. print $where->dump;
  30. # This should display
  31. # bar.h:1:
  32. # foo.c:14: included from here
  33. # Get the contexts (list of [$location_string, $description])
  34. for my $pair (reverse $where->contexts)
  35. {
  36. my ($loc, $descr) = @{$pair};
  37. ...
  38. }
  39. # Pop a context, and reset the location to the previous context.
  40. $where->pop_context;
  41. # Clone a Location. Use this when storing the state of a location
  42. # that would otherwise be modified.
  43. my $where_copy = $where->clone;
  44. # Serialize a Location object (for passing through a thread queue,
  45. # for example)
  46. my @array = $where->serialize ();
  47. # De-serialize: recreate a Location object from a queue.
  48. my $where = new Automake::Location::deserialize ($queue);
  49. =head1 DESCRIPTION
  50. C<Location> objects are used to keep track of locations in Automake,
  51. and used to produce diagnostics.
  52. A C<Location> object is made of two parts: a location string, and
  53. a stack of contexts.
  54. For instance if C<VAR> is defined at line 1 in F<bar.h> which was
  55. included at line 14 in F<foo.c>, then the location string should be
  56. C<"bar.h:10"> and the context should be the pair (C<"foo.c:14">,
  57. C<"included from here">).
  58. Section I<SYNOPSIS> shows how to setup such a C<Location>, and access
  59. the location string or the stack of contexts.
  60. You can pass a C<Location> to C<Automake::Channels::msg>.
  61. =cut
  62. =head2 Methods
  63. =over
  64. =item C<$where = new Automake::Location ([$position])>
  65. Create and return a new Location object.
  66. =cut
  67. sub new ($;$)
  68. {
  69. my ($class, $position) = @_;
  70. my $self = {
  71. position => $position,
  72. contexts => [],
  73. };
  74. bless $self, $class;
  75. return $self;
  76. }
  77. =item C<$location-E<gt>set ($position)>
  78. Change the location to be C<$position>.
  79. =cut
  80. sub set ($$)
  81. {
  82. my ($self, $position) = @_;
  83. $self->{'position'} = $position;
  84. }
  85. =item C<$location-E<gt>get>
  86. Get the location (without context).
  87. =cut
  88. sub get ($)
  89. {
  90. my ($self) = @_;
  91. return $self->{'position'};
  92. }
  93. =item C<$location-E<gt>push_context ($context)>
  94. Push a context to the location.
  95. =cut
  96. sub push_context ($$)
  97. {
  98. my ($self, $context) = @_;
  99. push @{$self->{'contexts'}}, [$self->get, $context];
  100. $self->set (undef);
  101. }
  102. =item C<$where = $location-E<gt>pop_context ($context)>
  103. Pop a context, and reset the location to the previous context.
  104. =cut
  105. sub pop_context ($)
  106. {
  107. my ($self) = @_;
  108. my $pair = pop @{$self->{'contexts'}};
  109. $self->set ($pair->[0]);
  110. return @{$pair};
  111. }
  112. =item C<@contexts = $location-E<gt>get_contexts>
  113. Return the array of contexts.
  114. =cut
  115. sub get_contexts ($)
  116. {
  117. my ($self) = @_;
  118. return @{$self->{'contexts'}};
  119. }
  120. =item C<$location = $location-E<gt>clone>
  121. Clone a Location. Use this when storing the state of a location
  122. that would otherwise be modified.
  123. =cut
  124. sub clone ($)
  125. {
  126. my ($self) = @_;
  127. my $other = new Automake::Location ($self->get);
  128. my @contexts = $self->get_contexts;
  129. for my $pair (@contexts)
  130. {
  131. push @{$other->{'contexts'}}, [@{$pair}];
  132. }
  133. return $other;
  134. }
  135. =item C<$res = $location-E<gt>dump>
  136. Print the location and the stack of context (for debugging).
  137. =cut
  138. sub dump ($)
  139. {
  140. my ($self) = @_;
  141. my $res = ($self->get || 'INTERNAL') . ":\n";
  142. for my $pair (reverse $self->get_contexts)
  143. {
  144. $res .= $pair->[0] || 'INTERNAL';
  145. $res .= ": $pair->[1]\n";
  146. }
  147. return $res;
  148. }
  149. =item C<@array = $location-E<gt>serialize>
  150. Serialize a Location object (for passing through a thread queue,
  151. for example).
  152. =cut
  153. sub serialize ($)
  154. {
  155. my ($self) = @_;
  156. my @serial = ();
  157. push @serial, $self->get;
  158. my @contexts = $self->get_contexts;
  159. for my $pair (@contexts)
  160. {
  161. push @serial, @{$pair};
  162. }
  163. push @serial, undef;
  164. return @serial;
  165. }
  166. =item C<new Automake::Location::deserialize ($queue)>
  167. De-serialize: recreate a Location object from a queue.
  168. =cut
  169. sub deserialize ($)
  170. {
  171. my ($queue) = @_;
  172. my $position = $queue->dequeue ();
  173. my $self = new Automake::Location $position;
  174. while (my $position = $queue->dequeue ())
  175. {
  176. my $context = $queue->dequeue ();
  177. push @{$self->{'contexts'}}, [$position, $context];
  178. }
  179. return $self;
  180. }
  181. =back
  182. =head1 SEE ALSO
  183. L<Automake::Channels>
  184. =head1 HISTORY
  185. Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>.
  186. =cut
  187. 1;
  188. ### Setup "GNU" style for perl-mode and cperl-mode.
  189. ## Local Variables:
  190. ## perl-indent-level: 2
  191. ## perl-continued-statement-offset: 2
  192. ## perl-continued-brace-offset: 0
  193. ## perl-brace-offset: 0
  194. ## perl-brace-imaginary-offset: 0
  195. ## perl-label-offset: -2
  196. ## cperl-indent-level: 2
  197. ## cperl-brace-offset: 0
  198. ## cperl-continued-brace-offset: 0
  199. ## cperl-label-offset: -2
  200. ## cperl-extra-newline-before-brace: t
  201. ## cperl-merge-trailing-else: nil
  202. ## cperl-continued-statement-offset: 2
  203. ## End: