diff --git a/Changes b/Changes index a23dbd38..66d09b28 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,7 @@ Revision history for Perl extension PPI {{$NEXT}} - Allow zero byte documents to have a location + - Allow variable names to have whitespace after the sigil (GH#158) 1.281 2024-12-27 14:44:47Z Summary: diff --git a/lib/PPI/Token/Symbol.pm b/lib/PPI/Token/Symbol.pm index 99e7ca88..2143e121 100644 --- a/lib/PPI/Token/Symbol.pm +++ b/lib/PPI/Token/Symbol.pm @@ -162,7 +162,7 @@ sub __TOKENIZER__on_char { # Suck in till the end of the symbol pos $t->{line} = $t->{line_cursor}; - if ( $t->{line} =~ m/\G([\w:\']+)/gc ) { + if ( $t->{line} =~ m/\G(\s*[\w:\']+)/gc ) { $t->{token}->{content} .= $1; $t->{line_cursor} += length $1; } @@ -201,6 +201,7 @@ sub __TOKENIZER__on_char { my $pattern = qr/ ^( [\$@%&*] + \s* (?: : (?! : ) # allow single-colon non-magic variables | diff --git a/lib/PPI/Token/Unknown.pm b/lib/PPI/Token/Unknown.pm index 86db997b..e7fd1a00 100644 --- a/lib/PPI/Token/Unknown.pm +++ b/lib/PPI/Token/Unknown.pm @@ -115,6 +115,14 @@ sub __TOKENIZER__on_char { return 1; } + if ( $char eq ' ' ) { + pos $t->{line} = $t->{line_cursor} + 1; + if ( $t->{line} =~ m/\G\s*[a-z_]/gci ) { + $t->{class} = $t->{token}->set_class('Symbol'); + return 1; + } + } + # Is it a nameless arg in a signature? if ( $char eq ')' or $char eq '=' or $char eq ',' ) { my ($has_sig) = $t->_current_token_has_signatures_active; diff --git a/t/foreach_whitespace.t b/t/foreach_whitespace.t new file mode 100644 index 00000000..154af978 --- /dev/null +++ b/t/foreach_whitespace.t @@ -0,0 +1,113 @@ +#!/usr/bin/perl + +BEGIN { chdir ".." if -d "../t" and -d "../lib" } +use lib 't/lib'; +use PPI::Test::pragmas; +use Test::More tests => 8 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); + +use B 'perlstring'; + +use PPI (); +use PPI::Dumper; + +sub test_document; + +BASE_SPACE_SYMBOL: { + test_document # + '$ s', # + [ + 'PPI::Statement', '$ s', # + 'PPI::Token::Symbol', '$ s', + ], + "base space symbol example"; +} + +FOR_LOOP: { + test_document + 'for my $ s ( qw( a b ) ) { say $s }', + [ + 'PPI::Statement::Compound', 'for my $ s ( qw( a b ) ) { say $s }', + 'PPI::Token::Word', 'for', + 'PPI::Token::Word', 'my', + 'PPI::Token::Symbol', '$ s', + 'PPI::Structure::List', '( qw( a b ) )', + 'PPI::Token::Structure', '(', + 'PPI::Statement', 'qw( a b )', + 'PPI::Token::QuoteLike::Words', 'qw( a b )', + 'PPI::Token::Structure', ')', + 'PPI::Structure::Block', '{ say $s }', + 'PPI::Token::Structure', '{', + 'PPI::Statement', 'say $s', + 'PPI::Token::Word', 'say', + 'PPI::Token::Symbol', '$s', + 'PPI::Token::Structure', '}', + ], + "space symboln in for loop"; +} + +SIGIL_WITH_TRASH: { + test_document + '$ \"8;b', + [ + 'PPI::Statement', '$ \\"8;b', + 'PPI::Token::Cast', '$', + 'PPI::Token::Cast', '\\', + 'PPI::Token::Quote::Double', '"8;b', + ], + "sigil with a space and trash that is NOT a symbol"; +} + +SIGIL_WITH_TABS_AND_TRAIL: { + test_document # + '$ b ', # + [ # + 'PPI::Statement', "\$ \t b", + 'PPI::Token::Symbol', "\$ \t b", + ], + "sigil with tabs and trailing space"; +} + +sub one_line_explain { + my ($data) = @_; + my @explain = explain $data; + s/\n//g for @explain; + return join "", @explain; +} + +sub main_level_line { + return "" if not $TODO; + my @outer_final; + my $level = 0; + while ( my @outer = caller( $level++ ) ) { + @outer_final = @outer; + } + return "l $outer_final[2] - "; +} + +sub test_document { + local $Test::Builder::Level = $Test::Builder::Level + 1; + my $args = ref $_[0] eq "ARRAY" ? shift : []; + my ( $code, $expected, $msg ) = @_; + $msg = perlstring $code if !defined $msg; + + my $d = PPI::Document->new( \$code, @{$args} ) or do { + diag explain $@; + fail "PPI::Document->new failed"; + fail "code round trips"; + return; + }; + my $tokens = $d->find( sub { $_[1]->significant } ); + $tokens = [ map { ref($_), $_->content } @$tokens ]; + + is $d->serialize, $code, "code round trips"; + + return if # + is_deeply( $tokens, $expected, main_level_line . $msg ); + + diag ">>> $code -- $msg\n"; + diag( PPI::Dumper->new($d)->string ); + diag one_line_explain $tokens; + diag one_line_explain $expected; + + return; +}