diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2020-01-17 17:22:23 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2020-01-17 17:22:23 +0200 |
commit | 53315c74cfb1f5080c56152fd3bd7e178e28378d (patch) | |
tree | 0fdaba841613710cb0aa0af9e407516b8a3c3a26 | |
parent | 10d2cf26f4f6fe40eaeb6db8c3e9b805acf846f0 (diff) | |
download | text-locus-53315c74cfb1f5080c56152fd3bd7e178e28378d.tar.gz text-locus-53315c74cfb1f5080c56152fd3bd7e178e28378d.tar.bz2 |
Add inspection methods.
* lib/Text/Locus.pm (has_file,filenames)
(filelines,equals): New methods.
Overload eq, and ==.
* t/20fixup.t: Bugfix.
* t/40inspect.t: New file.
-rw-r--r-- | lib/Text/Locus.pm | 92 | ||||
-rw-r--r-- | t/20fixup.t | 1 | ||||
-rw-r--r-- | t/40inspect.t | 20 |
3 files changed, 106 insertions, 7 deletions
diff --git a/lib/Text/Locus.pm b/lib/Text/Locus.pm index 62cf528..2c50a0e 100644 --- a/lib/Text/Locus.pm +++ b/lib/Text/Locus.pm @@ -101,6 +101,48 @@ sub add { return $self; } +=head2 has_file + + if ($locus->has_file($file)) ... + +Returns true if the filename B<$file> is present in the locus. + +=cut + +sub has_file { + my ($self, $file) = @_; + return exists($self->{_table}{$file}); +} + +=head2 filenames + + @list = $locus->filenames + +Returns a list of file names from the locus. The list preserves the +order in which filenames were added to the locus. + +=cut + +sub filenames { + my ($self) = @_; + sort { $self->{_table}{$a}{_order} <=> $self->{_table}{$b}{_order} } + keys %{$self->{_table}}; +} + +=head2 filelines + + @list = $locus->filelines($file) + +Returns the list of lines in <$file> which are part of this locus. + +=cut + +sub filelines { + my ($self, $file) = @_; + return unless $self->has_file($file); + return @{$self->{_table}{$file}{_lines}} +} + =head2 union $locus->union($locus2); @@ -152,10 +194,7 @@ sub format { my $self = shift; unless (exists($self->{_string})) { $self->{_string} = ''; - foreach my $file (sort { - $self->{_table}{$a}{_order} <=> $self->{_table}{$b}{_order} - } - keys %{$self->{_table}}) { + foreach my $file ($self->filenames) { $self->{_string} .= ';' if $self->{_string}; $self->{_string} .= "$file"; if (my @lines = @{$self->{_table}{$file}{_lines}}) { @@ -195,6 +234,20 @@ sub format { return $self->{_string}; } +=head2 equals + + $bool = $locus->equals($other); + +Returns true if $locus and $other are equal (i.e. refer to the same +source file location). + +=cut + +sub equals { + my ($self, $other) = @_; + return $self->format eq $other->format; +} + =head1 OVERLOADED OPERATIONS When used in a string, the locus object formats itself. E.g. to print @@ -218,7 +271,9 @@ Moreover, a term can also be a string in the form C<I<file>:I<line>>: or "file:10" + $loc - + +Two locus objects can be compared for equality using B<==> or B<eq> operators. + =cut use overload @@ -236,7 +291,9 @@ use overload } else { croak "bad argument type in locus addition"; } - }; + }, + 'eq' => \&equals, + '==' => \= =head1 FIXUPS @@ -312,4 +369,27 @@ sub fixup_lines { delete $self->{_string}; } +=head1 AUTHOR + +Sergey Poznyakoff, E<lt>gray@gnu.orgE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2018 by Sergey Poznyakoff + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +It is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this library. If not, see <http://www.gnu.org/licenses/>. + +=cut + 1; diff --git a/t/20fixup.t b/t/20fixup.t index 5fc1f42..2f487dd 100644 --- a/t/20fixup.t +++ b/t/20fixup.t @@ -10,7 +10,6 @@ BEGIN { my $loc = new Text::Locus; -my $loc = new Text::Locus; $loc->add('foo', 10, 11, 12, 13); $loc->add('foo', 24, 28); $loc->add('bar', 1, 5); diff --git a/t/40inspect.t b/t/40inspect.t new file mode 100644 index 0000000..c5956df --- /dev/null +++ b/t/40inspect.t @@ -0,0 +1,20 @@ +# -*- perl -*- +use strict; +use lib qw(t lib); +use Test::More; + +BEGIN { + plan(tests => 7); + use_ok('Text::Locus'); +}; + +my $loc = new Text::Locus; +$loc->add('foo', 10, 11, 12); +$loc->add('bar', 1); +ok($loc->has_file('foo')); +ok($loc->has_file('bar')); +ok(!$loc->has_file('baz')); +is(join(',',$loc->filenames), 'foo,bar'); +is(join(',',$loc->filelines('foo')),'10,11,12'); +ok($loc eq $loc->clone); + |