Skip Menu |
 

Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

This queue is for tickets about the PPI CPAN distribution.

Report information
The Basics
Id: 17301
Status: resolved
Priority: 0/
Queue: PPI

People
Owner: Nobody in particular
Requestors: arjen [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: (no value)
Fixed in: (no value)



Download (untitled) / with headers
text/plain 102b
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
Download (untitled) / with headers
text/plain 171b
On Thu Jan 26 16:33:42 2006, ARJEN wrote: Show quoted text
> I implemented the visual location feature, as discussed on IRC. Patch > attached. It's against > 1.109.
Committed to CVS.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.