I implemented the visual location feature, as discussed on IRC. Patch attached. It's against
1.109.
| Subject: | PPI_visual_location.diff |
Index: t/12_location.t
===================================================================
--- t/12_location.t (revision 1)
+++ t/12_location.t (working copy)
@@ -21,14 +21,14 @@
use PPI;
# Execute the tests
-use Test::More tests => 333;
+use Test::More tests => 490;
my $test_source = <<'END_PERL';
my $foo = 'bar';
# comment
sub foo {
- my ($this, $that) = (<<'THIS', <<"THAT");
+ my ($this, $that) = (<<'THIS', <<"THAT");
foo
bar
baz
@@ -38,6 +38,13 @@
THAT
}
+sub baz {
+ # sub baz contains *tabs*
+ my ($one, $other) = ("one", "other"); # contains 4 tabs
+
+ foo() ;
+}
+
sub bar {
baz();
@@ -58,120 +65,165 @@
1;
END_PERL
my @test_locations = (
- [ 1, 1 ],
- [ 1, 3 ], #
- [ 1, 4 ], #$foo
- [ 1, 8 ], #
- [ 1, 9 ], #=
- [ 1, 10 ], #
- [ 1, 11 ], #'bar'
- [ 1, 16 ], #;
+ [ 1, 1, 1 ], # my
+ [ 1, 3, 3 ], # ' '
+ [ 1, 4, 4 ], # $foo
+ [ 1, 8, 8 ], # ' '
+ [ 1, 9, 9 ], # =
+ [ 1, 10, 10 ], # ' '
+ [ 1, 11, 11 ], # 'bar'
+ [ 1, 16, 16 ], # ;
+ [ 1, 17, 17 ], # \n
- [ 1, 17 ], #\n
- [ 2, 1 ], #\n
+ [ 2, 1, 1 ], # \n
- [ 3, 1 ], # # comment
+ [ 3, 1, 1 ], # # comment
- [ 4, 1 ], #sub
- [ 4, 4 ], #
- [ 4, 5 ], #foo
- [ 4, 8 ], #
- [ 4, 9 ], #{
- [ 4, 10 ], #\n
+ [ 4, 1, 1 ], # sub
+ [ 4, 4, 4 ], # ' '
+ [ 4, 5, 5 ], # foo
+ [ 4, 8, 8 ], # ' '
+ [ 4, 9, 9 ], # {
+ [ 4, 10, 10 ], # \n
- [ 5, 1 ], # tab
- [ 5, 2 ], #my
- [ 5, 4 ], #
- [ 5, 5 ], #(
- [ 5, 6 ], #$this
- [ 5, 11 ], #,
- [ 5, 12 ], #
- [ 5, 13 ], #$that
- [ 5, 18 ], #)
- [ 5, 19 ], #
- [ 5, 20 ], #=
- [ 5, 21 ], #
- [ 5, 22 ], #(
- [ 5, 23 ], #<<'THIS'
- [ 5, 31 ], #,
- [ 5, 32 ], #
- [ 5, 33 ], #<<"THAT"
- [ 5, 41 ], #)
- [ 5, 42 ], #;
- [ 5, 43 ], #\n
+ [ 5, 1, 1 ], # ' '
+ [ 5, 5, 5 ], # my
+ [ 5, 7, 7 ], # ' '
+ [ 5, 8, 8 ], # (
+ [ 5, 9, 9 ], # $this
+ [ 5, 14, 14 ], # ,
+ [ 5, 15, 15 ], # ' '
+ [ 5, 16, 16 ], # $that
+ [ 5, 21, 21 ], # )
+ [ 5, 22, 22 ], # ' '
+ [ 5, 23, 23 ], # =
+ [ 5, 24, 24 ], # ' '
+ [ 5, 25, 25 ], # (
+ [ 5, 26, 26 ], # <<'THIS'
+ [ 5, 34, 34 ], # ,
+ [ 5, 35, 35 ], # ' '
+ [ 5, 36, 36 ], # <<"THAT"
+ [ 5, 44, 44 ], # )
+ [ 5, 45, 45 ], # ;
+ [ 5, 46, 46 ], # \n
- [ 13, 1 ], #}
- [ 13, 2 ], #\n
+ [ 13, 1, 1 ], # }
+ [ 13, 2, 2 ], # \n
- [ 14, 1 ], #\n
+ [ 14, 1, 1 ], # \n
- [ 15, 1 ], #sub
- [ 15, 4 ], #
- [ 15, 5 ], #bar
- [ 15, 8 ], #
- [ 15, 9 ], #{
- [ 15, 10 ], #\n
+ [ 15, 1, 1 ], # sub
+ [ 15, 4, 4 ], # ' '
+ [ 15, 5, 5 ], # baz
+ [ 15, 8, 8 ], # ' '
+ [ 15, 9, 9 ], # {
+ [ 15, 10, 10 ], # \n
- [ 16, 1 ], # whitespace
- [ 16, 5 ], #baz
- [ 16, 8 ], #(
- [ 16, 9 ], #)
- [ 16, 10 ], #;
- [ 16, 11 ], #\n
+ [ 16, 1, 1 ], # tab# sub baz contains *tabs*
+ [ 17, 1, 1 ], # tab
+ [ 17, 2, 5 ], # my
+ [ 17, 4, 7 ], # ' '
+ [ 17, 5, 8 ], # (
+ [ 17, 6, 9 ], # $one
+ [ 17, 10, 13 ], # ,
+ [ 17, 11, 14 ], # ' '
+ [ 17, 12, 15 ], # $other
+ [ 17, 18, 21 ], # )
+ [ 17, 19, 22 ], # ' '
+ [ 17, 20, 23 ], # =
+ [ 17, 21, 24 ], # ' tab'
+ [ 17, 23, 29 ], # (
+ [ 17, 24, 30 ], # "one"
+ [ 17, 29, 35 ], # ,
+ [ 17, 30, 36 ], # tab
+ [ 17, 31, 37 ], # "other"
+ [ 17, 38, 44 ], # )
+ [ 17, 39, 45 ], # ;
+ [ 17, 40, 46 ], # tab
+ [ 17, 41, 49 ], # # contains 3 tabs
+ [ 17, 58, 66 ], # \n
- [ 17, 1 ], #\n
+ [ 18, 1, 1 ], # \n\t
- [ 18, 1 ], #comment
+ [ 19, 2, 5 ], # foo
+ [ 19, 5, 8 ], # (
+ [ 19, 6, 9 ], # )
+ [ 19, 7, 10 ], # tab
+ [ 19, 8, 13 ], # ;
+ [ 19, 9, 14 ], # \n
- [ 19, 1 ], #\n whitespace
+ [ 20, 1, 1 ], # {
+ [ 20, 2, 2 ], # \n
- [ 20, 5 ], #bas
- [ 20, 8 ], #(
- [ 20, 9 ], #)
- [ 20, 10 ], #;
- [ 20, 11 ], #\n
+ [ 21, 1, 1 ], # \n
- [ 21, 1 ], #}
- [ 21, 2 ], #\n
+ [ 22, 1, 1 ], # sub
+ [ 22, 4, 4 ], # ' '
+ [ 22, 5, 5 ], # bar
+ [ 22, 8, 8 ], # ' '
+ [ 22, 9, 9 ], # {
+ [ 22, 10, 10 ], # \n
- [ 22, 1 ], #\n
+ [ 23, 1, 1 ], # ' '
+ [ 23, 5, 5 ], # baz
+ [ 23, 8, 8 ], # (
+ [ 23, 9, 9 ], # )
+ [ 23, 10, 10 ], # ;
+ [ 23, 11, 11 ], # \n
- [ 23, 1 ], #=head2
+ [ 24, 1, 1 ], # \n
- [ 28, 1 ], #sub
- [ 28, 4 ], #
- [ 28, 5 ], #fluzz
- [ 28, 10 ], #
- [ 28, 11 ], #{
- [ 28, 12 ], #\n
+ [ 25, 1, 1 ], # #Note that there are leading 4 x space, ...
- [ 29, 1 ], #
- [ 29, 5 ], #print
- [ 29, 10 ], #
- [ 29, 11 ], #"fluzz"
- [ 29, 18 ], #;
- [ 29, 19 ], #\n
+ [ 26, 1, 1 ], # '\n '
- [ 30, 1 ], #}
- [ 30, 2 ], #\n
+ [ 27, 5, 5 ], # bas
+ [ 27, 8, 8 ], # (
+ [ 27, 9, 9 ], # )
+ [ 27, 10, 10 ], # ;
+ [ 27, 11, 11 ], # \n
- [ 31, 1 ], #\n
+ [ 28, 1, 1 ], # }
+ [ 28, 2, 2 ], # \n
- [ 32, 1 ], #1
- [ 32, 2 ], #;
- [ 32, 3 ], #\n
- );
+ [ 29, 1, 1 ], # \n
+ [ 30, 1, 1 ], # =head2 fluzz() ...
+ [ 35, 1, 1 ], # sub
+ [ 35, 4, 4 ], # ' '
+ [ 35, 5, 5 ], # fluzz
+ [ 35, 10, 10 ], # ' '
+ [ 35, 11, 11 ], # {
+ [ 35, 12, 12 ], # \n
+ [ 36, 1, 1 ], # ' '
+ [ 36, 5, 5 ], # print
+ [ 36, 10, 10 ], # ' '
+ [ 36, 11, 11 ], # "fluzz"
+ [ 36, 18, 18 ], # ;
+ [ 36, 19, 19 ], # \n
+ [ 37, 1, 1 ], # }
+ [ 37, 2, 2 ], # \n
+ [ 38, 1, 1 ], # \n
+
+ [ 39, 1, 1 ], # 1
+ [ 39, 2, 2 ], # ;
+ [ 39, 3, 3 ], # \n
+);
+
+
+
#####################################################################
# Test the locations of everything in the test code
# Prepare
my $Document = PPI::Document->new( \$test_source );
isa_ok( $Document, 'PPI::Document' );
+$Document->tab_width(4);
+is($Document->tab_width, 4, 'Tab width set correctly');
ok( $Document->index_locations, '->index_locations returns true' );
# Now check the locations of every token
@@ -180,8 +232,8 @@
foreach my $i ( 0 .. $#test_locations ) {
my $location = $tokens[$i]->location;
is( ref($location), 'ARRAY', "Token $i: ->location returns an ARRAY ref" );
- is( scalar(@$location), 2, "Token $i: ->location returns a 2 element ARRAY ref" );
- ok( ($location->[0] > 0 and $location->[1] > 0), "Token $i: ->location returns two positive positions" );
+ is( scalar(@$location), 3, "Token $i: ->location returns a 3 element ARRAY ref" );
+ ok( ($location->[0] > 0 and $location->[1] > 0 and $location->[2] > 0), "Token $i: ->location returns three positive positions" );
is_deeply( $tokens[$i]->location, $test_locations[$i], "Token $i: ->location matches expected" );
}
Index: lib/PPI/Document.pm
===================================================================
--- lib/PPI/Document.pm (revision 1)
+++ lib/PPI/Document.pm (working copy)
@@ -271,7 +271,7 @@
sub tab_width {
my $self = shift;
return $self->{tab_width} unless @_;
- Carp::croak("PPI FEATURE INCOMPLETE(Only naive tabs (width 1) are supported at this time)");
+ $self->{tab_width} = shift;
}
=pod
@@ -483,7 +483,7 @@
# Calculate the new location if needed.
$location = $first
? $self->_add_location( $location, $Tokens[$_ - 1], \$heredoc )
- : [ 1, 1 ];
+ : [ 1, 1, 1 ];
$first = $_;
last;
}
@@ -511,12 +511,16 @@
my $newlines =()= $content =~ /\n/g;
unless ( $newlines ) {
# Handle the simple case
- return [ $start->[0], $start->[1] + length($content) ];
+ return [
+ $start->[0],
+ $start->[1] + length($content),
+ $start->[2] + $self->_visual_length($content, $start->[2])
+ ];
}
# This is the more complex case where we hit or
# span a newline boundary.
- my $location = [ $start->[0] + $newlines, 1 ];
+ my $location = [ $start->[0] + $newlines, 1, 1 ];
if ( $heredoc and $$heredoc ) {
$location->[0] += $$heredoc;
$$heredoc = 0;
@@ -526,11 +530,36 @@
# after their last newline.
if ( $content =~ /\n([^\n]+?)\z/ ) {
$location->[1] += length($1);
+ $location->[2] += $self->_visual_length($1, $location->[2]);
}
$location;
}
+sub _visual_length {
+ my ($self, $content, $pos) = @_;
+
+ my $tab_width = $self->tab_width;
+ my ($length, $vis_inc);
+
+ return length $content if $content !~ /\t/;
+
+ # Split the content in tab and non-tab parts and calculate the
+ # "visual increase" of each part.
+ for my $part ( split(/(\t)/, $content) ) {
+ if ($part eq "\t") {
+ $vis_inc = $tab_width - ($pos-1) % $tab_width;
+ }
+ else {
+ $vis_inc = length $part;
+ }
+ $length += $vis_inc;
+ $pos += $vis_inc;
+ }
+
+ $length;
+}
+
=pod
=head2 flush_locations