| Subject: | index_location invalid for some newline and whitespace related stuff |
I'm using the location property to figure out what symbol is at the cursor position, and in doing so I found a few things that didn't work correctly. It seems to have mostly to do with newline related things.
a) When calculating the length of the last line, this should probably be the case:
# Does the token have additional characters
# after their last newline.
if ( $content =~ /\n([^\n]+?)$/ ) {
$location->[1] += length($1);
}
(the original only matches one char of the last line)
b) When writing tests for this I came upon something else. I think the whitespace parsing for comments is a bit off. It seems like the preceeding whitespace is regarded as part of the comment. So this comment:
#commment
isn't parsed as " " + "#comment", but " #comment". Is this a bug, or should it behave like that?
The attached patch contains tests and a fix for a) and b) is pointed out in the test case.
WinXP
perl -v
This is perl, v5.8.6 built for MSWin32-x86-multi-thread
/J
*** c:/DOCUME~1/linjoh/LOCALS~1/Temp/Document.pm Mon Jun 20 22:28:12 2005
--- c:/DOCUME~1/linjoh/LOCALS~1/Temp/Document.pm3908F22 Mon Jun 20 22:28:12 2005
***************
*** 379,385 ****
# Does the token have additional characters
# after their last newline.
! if ( $content =~ /\n([^\n])$/ ) {
$location->[1] += length($1);
}
--- 379,384 ----
# Does the token have additional characters
# after their last newline.
! if ( $content =~ /\n([^\n]+?)$/ ) {
$location->[1] += length($1);
}
*** c:/DOCUME~1/linjoh/LOCALS~1/Temp/12_location.t Mon Jun 20 22:29:54 2005
--- c:/DOCUME~1/linjoh/LOCALS~1/Temp/12_location.t3908EKM Mon Jun 20 22:29:54 2005
***************
*** 22,28 ****
use PPI;
# Execute the tests
! use Test::More tests => 105;
my $test_source = <<'END_PERL';
my $foo = 'bar';
--- 22,28 ----
use PPI;
# Execute the tests
! use Test::More tests => 269;
my $test_source = <<'END_PERL';
my $foo = 'bar';
***************
*** 39,72 ****
THAT
}
1;
END_PERL
my @test_locations = (
[ 1, 1 ],
! [ 1, 4 ],
! [ 1, 9 ],
! [ 1, 11 ],
! [ 1, 16 ],
! [ 3, 1 ],
! [ 4, 1 ],
! [ 4, 5 ],
! [ 4, 9 ],
! [ 5, 2 ],
! [ 5, 5 ],
! [ 5, 6 ],
! [ 5, 11 ],
! [ 5, 13 ],
! [ 5, 18 ],
! [ 5, 20 ],
! [ 5, 22 ],
! [ 5, 23 ],
! [ 5, 31 ],
! [ 5, 33 ],
! [ 5, 41 ],
! [ 5, 42 ],
! [ 13, 1 ],
! [ 15, 1 ],
! [ 15, 2 ],
);
--- 39,136 ----
THAT
}
+ sub bar {
+ baz();
+
+ #Note that there are leading 4 x space, not 1 x tab in the sub bar
+
+ bas();
+ }
+
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, 17 ], #\n
! [ 2, 1 ], #\n
!
! [ 3, 1 ], # # comment
!
! [ 4, 1 ], #sub
! [ 4, 4 ], #
! [ 4, 5 ], #foo
! [ 4, 8 ], #
! [ 4, 9 ], #{
! [ 4, 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
!
! [ 13, 1 ], #}
! [ 13, 2 ], #\n
!
! [ 14, 1 ], #\n
!
! [ 15, 1 ], #sub
! [ 15, 4 ], #
! [ 15, 5 ], #bar
! [ 15, 8 ], #
! [ 15, 9 ], #{
! [ 15, 10 ], #\n
!
! [ 16, 1 ], # whitespace
! [ 16, 5 ], #baz
! [ 16, 8 ], #(
! [ 16, 9 ], #)
! [ 16, 10 ], #;
! [ 16, 11 ], #\n
!
! [ 17, 1 ], #\n
!
! [ 18, 1 ], #comment !BUG! Should be 5, and a whitespace chunk before it (now the preceeding whitespace is part of the comment string)
!
! [ 19, 1 ], #\n whitespace
!
! [ 20, 5 ], #bas
! [ 20, 8 ], #(
! [ 20, 9 ], #)
! [ 20, 10 ], #;
! [ 20, 11 ], #\n
!
! [ 21, 1 ], #}
! [ 21, 2 ], #\n
!
! [ 22, 1 ], #\n
!
! [ 23, 1 ], #1
! [ 23, 2 ], #;
! [ 23, 3 ], #\n
);
***************
*** 82,95 ****
ok( $Document->index_locations, '->index_locations returns true' );
# Now check the locations of every token
! my @tokens = grep { ! $_->isa('PPI::Token::Whitespace') } $Document->tokens;
! is( scalar(@tokens), scalar(@test_locations), 'Number of non-whitespace tokens matches expected' );
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_deeply( $test_locations[$i], $tokens[$i]->location, "Token $i: ->location matches expected" );
}
ok( $Document->flush_locations, '->flush_locations returns true' );
--- 146,160 ----
ok( $Document->index_locations, '->index_locations returns true' );
# Now check the locations of every token
! my @tokens = $Document->tokens; # grep { ! $_->isa('PPI::Token::Whitespace') }
! is( scalar(@tokens), scalar(@test_locations), 'Number of tokens matches expected' );
foreach my $i ( 0 .. $#test_locations ) {
my $location = $tokens[$i]->location;
+ # my $token = "$tokens[$i]"; $token =~ s|\n|\\n|gs; print "\n$location->[0], $location->[1]: |$token|\n";
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_deeply( $tokens[$i]->location, $test_locations[$i], "Token $i: ->location matches expected" );
}
ok( $Document->flush_locations, '->flush_locations returns true' );