122 parsing x

Changes

@@ -1,4 +1,7 @@
 Revision history for Perl extension PPI
+	- Fix 1.218 regression where packages, subs, and words after
+	  labels like /^x\d+/ would parse as x operator (GitHub #122)
+	  (MOREGAN)
 
 1.221_01
 	Summary:

lib/PPI/Tokenizer.pm

@@ -102,7 +102,35 @@ my %X_CAN_FOLLOW_OPERATOR = map { $_ => 1 } qw( -- ++ );
 # These are the exceptions.
 my %X_CAN_FOLLOW_STRUCTURE = map { $_ => 1 } qw( } ] \) );
 
-
+# Something that looks like the x operator but follows a word
+# is usually that word's argument. 
+# These are the exceptions.
+# chop, chomp, dump are ambiguous because they can have either parms
+# or no parms.
+my %X_CAN_FOLLOW_WORD = map { $_ => 1 } qw(
+		endgrent
+		endhostent
+		endnetent
+		endprotoent
+		endpwent
+		endservent
+		fork
+		getgrent
+		gethostent
+		getlogin
+		getnetent
+		getppid
+		getprotoent
+		getpwent
+		getservent
+		setgrent
+		setpwent
+		time
+		times
+		wait
+		wantarray
+		__SUB__
+);
 
 
 
@@ -552,7 +580,7 @@ sub _process_next_char {
 	return 0 if ++$self->{line_cursor} >= $self->{line_length};
 
 	# Pass control to the token class
-        my $result;
+	my $result;
 	unless ( $result = $self->{class}->__TOKENIZER__on_char( $self ) ) {
 		# undef is error. 0 is "Did stuff ourself, you don't have to do anything"
 		return defined $result ? 1 : undef;
@@ -771,6 +799,8 @@ sub _current_x_is_operator {
 		$prev
 		&& (!$prev->isa('PPI::Token::Operator') || $X_CAN_FOLLOW_OPERATOR{$prev})
 		&& (!$prev->isa('PPI::Token::Structure') || $X_CAN_FOLLOW_STRUCTURE{$prev})
+		&& (!$prev->isa('PPI::Token::Word') || $X_CAN_FOLLOW_WORD{$prev})
+		&& !$prev->isa('PPI::Token::Label')
 	;
 }
 

t/ppi_statement_package.t

@@ -10,7 +10,7 @@ BEGIN {
 	$PPI::XS_DISABLE = 1;
 	$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
 }
-use Test::More tests => 14889;
+use Test::More tests => 14949;
 use Test::NoWarnings;
 use PPI;
 
@@ -69,6 +69,8 @@ PERL_5_12_SYNTAX: {
 		keys %PPI::Token::Word::KEYWORDS,
 		# regression: misparsed as version string
 		'v10',
+		# regression GitHub #122: 'x' parsed as x operator
+		'x64',
 		# Other weird and/or special words, just in case
 		'__PACKAGE__',
 		'__FILE__',
@@ -81,11 +83,11 @@ PERL_5_12_SYNTAX: {
 		[ 'v1.2.3', 'PPI::Token::Number::Version' ],
 		[ '0.50 ', 'PPI::Token::Number::Float' ],
 		[ '0.50', 'PPI::Token::Number::Float' ],
-		[ '', '' ],  # omit version
+		[ '', '' ],  # omit version, traditional 
 	);
 	my @blocks = (
-		[ ';', 'PPI::Token::Structure' ],
-		[ '{ 1 }', 'PPI::Structure::Block' ],
+		[ ';', 'PPI::Token::Structure' ],  # traditional package syntax
+		[ '{ 1 }', 'PPI::Structure::Block' ],  # 5.12 package syntax
 	);
 	$_->[2] = strip_ws_padding( $_->[0] ) for @versions, @blocks;
 

t/ppi_statement_sub.t

@@ -10,7 +10,7 @@ BEGIN {
 	$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
 }
 
-use Test::More tests => 6204;
+use Test::More tests => 6208;
 use Test::NoWarnings;
 use PPI;
 
@@ -28,6 +28,7 @@ NAME: {
 		{ code => 'sub baz : method lvalue{}', name => 'baz' },
 		{ code => 'sub baz : method:lvalue{}', name => 'baz' },
 		{ code => 'sub baz (*) : method : lvalue{}', name => 'baz' },
+		{ code => 'sub x64 {}',  name => 'x64' },  # should not be parsed as x operator
 	) {
 		my $code = $test->{code};
 		my $name = $test->{name};

t/ppi_token_operator.t

@@ -13,7 +13,7 @@ BEGIN {
 	$PPI::XS_DISABLE = 1;
 	$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
 }
-use Test::More tests => 1119;
+use Test::More tests => 1142;
 use Test::NoWarnings;
 use PPI;
 
@@ -409,6 +409,17 @@ OPERATOR_X: {
 				'PPI::Token::Structure' => '}',
 			]
 		},
+		{
+			desc => 'label plus x',
+			code => 'LABEL: x64',
+			expected => [
+				'PPI::Statement::Compound' => 'LABEL:',
+				'PPI::Token::Label' => 'LABEL:',
+				'PPI::Token::Whitespace' => ' ',
+				'PPI::Statement' => 'x64',
+				'PPI::Token::Word' => 'x64',
+			]
+		},
 	);
 
 	# Exhaustively test when a preceding operator implies following
@@ -464,6 +475,45 @@ OPERATOR_X: {
 		push @tests, { desc => $desc, code => $code, expected => \@expected };
 	}
 
+
+	# Test that Perl builtins known to have a null prototype do not
+	# force a following 'x' to be a word.
+	my %noprotos = map { $_ => 1 } qw(
+		endgrent
+		endhostent
+		endnetent
+		endprotoent
+		endpwent
+		endservent
+		fork
+		getgrent
+		gethostent
+		getlogin
+		getnetent
+		getppid
+		getprotoent
+		getpwent
+		getservent
+		setgrent
+		setpwent
+		time
+		times
+		wait
+		wantarray
+		__SUB__
+	);
+	foreach my $noproto ( keys %noprotos ) {
+		my $code = "$noproto x3";
+		my @expected = (
+			'PPI::Token::Word' => $noproto,
+			'PPI::Token::Whitespace' => ' ',
+			'PPI::Token::Operator' => 'x',
+			'PPI::Token::Number' => '3',
+		);
+		my $desc = "builtin $noproto does not force following x to be a word";
+		push @tests, { desc => "builtin $noproto does not force following x to be a word", code => $code, expected => \@expected };
+	}
+
 	foreach my $test ( @tests ) {
 		my $d = PPI::Document->new( \$test->{code} );
 		my $tokens = $d->find( sub { 1; } );
@@ -524,7 +574,7 @@ OPERATOR_FAT_COMMA: {
 				'PPI::Token::Word' => $_,
 				'PPI::Token::Operator' => '=>',
 				'PPI::Token::Number' => '2',
-		    ]
+			]
 		} } keys %PPI::Token::Word::KEYWORDS ),
 		( map { {
 			desc=>$_,
@@ -537,7 +587,7 @@ OPERATOR_FAT_COMMA: {
 				'PPI::Token::Operator' => '=>',
 				'PPI::Token::Number' => '2',
 				'PPI::Token::Structure' => ')',
-		    ]
+			]
 		} } keys %PPI::Token::Word::KEYWORDS ),
 		( map { {
 			desc=>$_,
@@ -550,7 +600,7 @@ OPERATOR_FAT_COMMA: {
 				'PPI::Token::Operator' => '=>',
 				'PPI::Token::Number' => '2',
 				'PPI::Token::Structure' => '}',
-		    ]
+			]
 		} } keys %PPI::Token::Word::KEYWORDS ),
 	);