Skip to content

Commit 2c2a7d6

Browse files
moreganwchristian
authored andcommitted
Separate all keywords from immediately-following single quotes.
1 parent 7eb7c1b commit 2c2a7d6

File tree

3 files changed

+364
-74
lines changed

3 files changed

+364
-74
lines changed

Changes

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@ Revision history for Perl extension PPI
77
- Moved repository to GitHub: https://github.com/adamkennedy/PPI
88

99
Details:
10+
- Disallow Perl4 package separator ' immediately after keywords
11+
(GitHub #58) (MOREGAN)
1012
- Stop directing bugs to rt.cpan.org (GitHub #40) (MOREGAN)
1113
- Fix documentation reference to List::Util (RT #75308) (RWSTAUNER)
1214
- Improve scalability of parsing long lines, and remove the size

lib/PPI/Token/Word.pm

Lines changed: 33 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ now, look at L<Perl::Critic::Utils>.
3838
use strict;
3939
use PPI::Token ();
4040

41-
use vars qw{$VERSION @ISA %OPERATOR %QUOTELIKE};
41+
use vars qw{$VERSION @ISA %OPERATOR %QUOTELIKE %KEYWORDS};
4242
BEGIN {
4343
$VERSION = '1.218';
4444
@ISA = 'PPI::Token';
@@ -57,6 +57,35 @@ BEGIN {
5757
'tr' => 'Regexp::Transliterate',
5858
'y' => 'Regexp::Transliterate',
5959
);
60+
61+
# List of keywords is from regen/keywords.pl in the perl source.
62+
%KEYWORDS = map { $_ => 1 } qw{
63+
abs accept alarm and atan2 bind binmode bless break caller chdir chmod
64+
chomp chop chown chr chroot close closedir cmp connect continue cos
65+
crypt dbmclose dbmopen default defined delete die do dump each else
66+
elsif endgrent endhostent endnetent endprotoent endpwent endservent
67+
eof eq eval evalbytes exec exists exit exp fc fcntl fileno flock for
68+
foreach fork format formline ge getc getgrent getgrgid getgrnam
69+
gethostbyaddr gethostbyname gethostent getlogin getnetbyaddr
70+
getnetbyname getnetent getpeername getpgrp getppid getpriority
71+
getprotobyname getprotobynumber getprotoent getpwent getpwnam
72+
getpwuid getservbyname getservbyport getservent getsockname
73+
getsockopt given glob gmtime goto grep gt hex if index int ioctl join
74+
keys kill last lc lcfirst le length link listen local localtime lock
75+
log lstat lt m map mkdir msgctl msgget msgrcv msgsnd my ne next no
76+
not oct open opendir or ord our pack package pipe pop pos print
77+
printf prototype push q qq qr quotemeta qw qx rand read readdir
78+
readline readlink readpipe recv redo ref rename require reset return
79+
reverse rewinddir rindex rmdir s say scalar seek seekdir select semctl
80+
semget semop send setgrent sethostent setnetent setpgrp
81+
setpriority setprotoent setpwent setservent setsockopt shift shmctl
82+
shmget shmread shmwrite shutdown sin sleep socket socketpair sort
83+
splice split sprintf sqrt srand stat state study sub substr symlink
84+
syscall sysopen sysread sysseek system syswrite tell telldir tie tied
85+
time times tr truncate uc ucfirst umask undef unless unlink unpack
86+
unshift untie until use utime values vec wait waitpid wantarray warn
87+
when while write x xor y
88+
};
6089
}
6190

6291
=pod
@@ -133,12 +162,6 @@ sub method_call {
133162
}
134163

135164

136-
my %backoff = map { $_ => 1 } qw{
137-
eq ne ge le gt lt
138-
q qq qx qw qr m s tr y
139-
pack unpack
140-
};
141-
142165
sub __TOKENIZER__on_char {
143166
my $class = shift;
144167
my $t = shift;
@@ -149,8 +172,8 @@ sub __TOKENIZER__on_char {
149172
my $word = $1;
150173
# Special Case: If we accidentally treat eq'foo' like
151174
# the word "eq'foo", then just make 'eq' (or whatever
152-
# else is in the %backoff hash.
153-
if ( $word =~ /^(\w+)'/ && $backoff{$1} ) {
175+
# else is in the %KEYWORDS hash.
176+
if ( $word =~ /^(\w+)'/ && $KEYWORDS{$1} ) {
154177
$word = $1;
155178
}
156179
$t->{token}->{content} .= $word;
@@ -220,7 +243,7 @@ sub __TOKENIZER__commit {
220243
# Special Case: If we accidentally treat eq'foo' like the word "eq'foo",
221244
# then unwind it and just make it 'eq' (or the other stringy comparitors)
222245
my $word = $1;
223-
if ( $word =~ /^(\w+)'/ && $backoff{$1} ) {
246+
if ( $word =~ /^(\w+)'/ && $KEYWORDS{$1} ) {
224247
$word = $1;
225248
}
226249

0 commit comments

Comments
 (0)