summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2020-01-17 17:22:23 +0200
committerSergey Poznyakoff <gray@gnu.org.ua>2020-01-17 17:22:23 +0200
commit53315c74cfb1f5080c56152fd3bd7e178e28378d (patch)
tree0fdaba841613710cb0aa0af9e407516b8a3c3a26
parent10d2cf26f4f6fe40eaeb6db8c3e9b805acf846f0 (diff)
downloadtext-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.pm92
-rw-r--r--t/20fixup.t1
-rw-r--r--t/40inspect.t20
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,
+ '==' => \&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);
+

Return to:

Send suggestions and report system problems to the System administrator.