| 1 | # Copyright (C) 2002, 2003 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, write to the Free Software
|
|---|
| 15 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
|---|
| 16 | # 02110-1301, USA.
|
|---|
| 17 |
|
|---|
| 18 | package Automake::Location;
|
|---|
| 19 |
|
|---|
| 20 | =head1 NAME
|
|---|
| 21 |
|
|---|
| 22 | Automake::Location - a class for location tracking, with a stack of contexts
|
|---|
| 23 |
|
|---|
| 24 | =head1 SYNOPSIS
|
|---|
| 25 |
|
|---|
| 26 | use Automake::Location;
|
|---|
| 27 |
|
|---|
| 28 | # Create a new Location object
|
|---|
| 29 | my $where = new Automake::Location "foo.c:13";
|
|---|
| 30 |
|
|---|
| 31 | # Change the location
|
|---|
| 32 | $where->set ("foo.c:14");
|
|---|
| 33 |
|
|---|
| 34 | # Get the location (without context).
|
|---|
| 35 | # Here this should print "foo.c:14"
|
|---|
| 36 | print $where->get, "\n";
|
|---|
| 37 |
|
|---|
| 38 | # Push a context, and change the location
|
|---|
| 39 | $where->push_context ("included from here");
|
|---|
| 40 | $where->set ("bar.h:1");
|
|---|
| 41 |
|
|---|
| 42 | # Print the location and the stack of context (for debugging)
|
|---|
| 43 | print $where->dump;
|
|---|
| 44 | # This should display
|
|---|
| 45 | # bar.h:1:
|
|---|
| 46 | # foo.c:14: included from here
|
|---|
| 47 |
|
|---|
| 48 | # Get the contexts (list of [$location_string, $description])
|
|---|
| 49 | for my $pair (reverse $where->contexts)
|
|---|
| 50 | {
|
|---|
| 51 | my ($loc, $descr) = @{$pair};
|
|---|
| 52 | ...
|
|---|
| 53 | }
|
|---|
| 54 |
|
|---|
| 55 | # Pop a context, and reset the location from the previous context.
|
|---|
| 56 | $where->pop_context;
|
|---|
| 57 |
|
|---|
| 58 | # Clone a Location. Use this when storing the state of a location
|
|---|
| 59 | # that would otherwise be modified.
|
|---|
| 60 | my $where_copy = $where->clone;
|
|---|
| 61 |
|
|---|
| 62 | =head1 DESCRIPTION
|
|---|
| 63 |
|
|---|
| 64 | C<Location> objects are used to keep track of locations in Automake,
|
|---|
| 65 | and used to produce diagnostics.
|
|---|
| 66 |
|
|---|
| 67 | A C<Location> object is made of two parts: a location string, and
|
|---|
| 68 | a stack of contexts.
|
|---|
| 69 |
|
|---|
| 70 | For instance if C<VAR> is defined at line 1 in F<bar.h> which was
|
|---|
| 71 | included at line 14 in F<foo.c>, then the location string should be
|
|---|
| 72 | C<"bar.h:10"> and the context should be the pair (C<"foo.c:14">,
|
|---|
| 73 | C<"included from here">).
|
|---|
| 74 |
|
|---|
| 75 | Section I<SYNOPSIS> shows how to setup such a C<Location>, and access
|
|---|
| 76 | the location string or the stack of contexts.
|
|---|
| 77 |
|
|---|
| 78 | You can pass a C<Location> to C<Automake::Channels::msg>.
|
|---|
| 79 |
|
|---|
| 80 | =cut
|
|---|
| 81 |
|
|---|
| 82 | sub new ($;$)
|
|---|
| 83 | {
|
|---|
| 84 | my ($class, $position) = @_;
|
|---|
| 85 | my $self = {
|
|---|
| 86 | position => $position,
|
|---|
| 87 | contexts => [],
|
|---|
| 88 | };
|
|---|
| 89 | bless $self, $class;
|
|---|
| 90 | return $self;
|
|---|
| 91 | }
|
|---|
| 92 |
|
|---|
| 93 | sub set ($$)
|
|---|
| 94 | {
|
|---|
| 95 | my ($self, $position) = @_;
|
|---|
| 96 | $self->{'position'} = $position;
|
|---|
| 97 | }
|
|---|
| 98 |
|
|---|
| 99 | sub get ($)
|
|---|
| 100 | {
|
|---|
| 101 | my ($self) = @_;
|
|---|
| 102 | return $self->{'position'};
|
|---|
| 103 | }
|
|---|
| 104 |
|
|---|
| 105 | sub push_context ($$)
|
|---|
| 106 | {
|
|---|
| 107 | my ($self, $context) = @_;
|
|---|
| 108 | push @{$self->{'contexts'}}, [$self->get, $context];
|
|---|
| 109 | $self->set (undef);
|
|---|
| 110 | }
|
|---|
| 111 |
|
|---|
| 112 | sub pop_context ($)
|
|---|
| 113 | {
|
|---|
| 114 | my ($self) = @_;
|
|---|
| 115 | my $pair = pop @{$self->{'contexts'}};
|
|---|
| 116 | $self->set ($pair->[0]);
|
|---|
| 117 | return @{$pair};
|
|---|
| 118 | }
|
|---|
| 119 |
|
|---|
| 120 | sub get_contexts ($)
|
|---|
| 121 | {
|
|---|
| 122 | my ($self) = @_;
|
|---|
| 123 | return @{$self->{'contexts'}};
|
|---|
| 124 | }
|
|---|
| 125 |
|
|---|
| 126 | sub clone ($)
|
|---|
| 127 | {
|
|---|
| 128 | my ($self) = @_;
|
|---|
| 129 | my $other = new Automake::Location ($self->get);
|
|---|
| 130 | my @contexts = $self->get_contexts;
|
|---|
| 131 | for my $pair (@contexts)
|
|---|
| 132 | {
|
|---|
| 133 | push @{$other->{'contexts'}}, [@{$pair}];
|
|---|
| 134 | }
|
|---|
| 135 | return $other;
|
|---|
| 136 | }
|
|---|
| 137 |
|
|---|
| 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 |
|
|---|
| 150 | =head1 SEE ALSO
|
|---|
| 151 |
|
|---|
| 152 | L<Automake::Channels>
|
|---|
| 153 |
|
|---|
| 154 | =head1 HISTORY
|
|---|
| 155 |
|
|---|
| 156 | Written by Alexandre Duret-Lutz E<lt>F<[email protected]>E<gt>.
|
|---|
| 157 |
|
|---|
| 158 | =cut
|
|---|
| 159 |
|
|---|
| 160 | 1;
|
|---|
| 161 |
|
|---|
| 162 | ### Setup "GNU" style for perl-mode and cperl-mode.
|
|---|
| 163 | ## Local Variables:
|
|---|
| 164 | ## perl-indent-level: 2
|
|---|
| 165 | ## perl-continued-statement-offset: 2
|
|---|
| 166 | ## perl-continued-brace-offset: 0
|
|---|
| 167 | ## perl-brace-offset: 0
|
|---|
| 168 | ## perl-brace-imaginary-offset: 0
|
|---|
| 169 | ## perl-label-offset: -2
|
|---|
| 170 | ## cperl-indent-level: 2
|
|---|
| 171 | ## cperl-brace-offset: 0
|
|---|
| 172 | ## cperl-continued-brace-offset: 0
|
|---|
| 173 | ## cperl-label-offset: -2
|
|---|
| 174 | ## cperl-extra-newline-before-brace: t
|
|---|
| 175 | ## cperl-merge-trailing-else: nil
|
|---|
| 176 | ## cperl-continued-statement-offset: 2
|
|---|
| 177 | ## End:
|
|---|