support postfix dereference

Author: akiym

lib/PPI/Lexer.pm

@@ -1045,6 +1045,13 @@ sub _square {
 			# $foo[], @foo[]
 			return 'PPI::Structure::Subscript';
 		}
+		if ( $Element->isa('PPI::Token::Cast') and $Element->content =~ /^(?:\@|\%)/ ) {
+			my $prior = $Parent->schild(-2);
+			if ( $prior and $prior->isa('PPI::Token::Operator') and $prior->content eq '->' ) {
+				# Postfix dereference: ->@[...] ->%[...]
+				return 'PPI::Structure::Subscript';
+			}
+		}
 		# FIXME - More cases to catch
 	}
 
@@ -1121,6 +1128,13 @@ sub _curly {
 			# $foo{}, @foo{}
 			return 'PPI::Structure::Subscript';
 		}
+		if ( $Element->isa('PPI::Token::Cast') and $Element->content =~ /^(?:\@|\%|\*)/ ) {
+			my $prior = $Parent->schild(-2);
+			if ( $prior and $prior->isa('PPI::Token::Operator') and $prior->content eq '->' ) {
+				# Postfix dereference: ->@{...} ->%{...} ->*{...}
+				return 'PPI::Structure::Subscript';
+			}
+		}
 		if ( $Element->isa('PPI::Structure::Block') ) {
 			# deference - ${$hash_ref}{foo}
 			#     or even ${burfle}{foo}

lib/PPI/Token/Cast.pm

@@ -36,15 +36,30 @@ our $VERSION = '1.236';
 
 our @ISA = "PPI::Token";
 
+our %POSTFIX = map { $_ => 1 } (
+	qw{
+	%* @* $*
+	},
+	'$#*' # throws warnings if it's inside a qw
+);
+
 
 
 
 #####################################################################
 # Tokenizer Methods
 
 # A cast is either % @ $ or $#
+# and also postfix dereference are %* @* $* $#*
 sub __TOKENIZER__on_char {
-	$_[1]->_finalize_token->__TOKENIZER__on_char( $_[1] );
+	my $t    = $_[1];
+	my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
+
+	# Are we still an operator if we add the next character
+	my $content = $t->{token}->{content};
+	return 1 if $POSTFIX{ $content . $char };
+
+	$t->_finalize_token->__TOKENIZER__on_char( $t );
 }
 
 1;

lib/PPI/Token/Unknown.pm

@@ -77,6 +77,15 @@ sub __TOKENIZER__on_char {
 			}
 		}
 
+		# Postfix dereference: ->**
+		if ( $char eq '*' ) {
+			my ( $prev ) = $t->_previous_significant_tokens(1);
+			if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) {
+				$t->{class} = $t->{token}->set_class( 'Cast' );
+				return 1;
+			}
+		}
+
 		if ( $char eq '*' || $char eq '=' ) {
 			# Power operator '**' or mult-assign '*='
 			$t->{class} = $t->{token}->set_class( 'Operator' );
@@ -91,6 +100,15 @@ sub __TOKENIZER__on_char {
 
 
 	} elsif ( $c eq '$' ) {
+		# Postfix dereference: ->$* ->$#*
+		if ( $char eq '*' || $char eq '#' ) {
+			my ( $prev ) = $t->_previous_significant_tokens(1);
+			if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) {
+				$t->{class} = $t->{token}->set_class( 'Cast' );
+				return 1;
+			}
+		}
+
 		if ( $char =~ /[a-z_]/i ) {
 			# Symbol
 			$t->{class} = $t->{token}->set_class( 'Symbol' );
@@ -120,6 +138,15 @@ sub __TOKENIZER__on_char {
 
 
 	} elsif ( $c eq '@' ) {
+		# Postfix dereference: ->@*
+		if ( $char eq '*' ) {
+			my ( $prev ) = $t->_previous_significant_tokens(1);
+			if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) {
+				$t->{class} = $t->{token}->set_class( 'Cast' );
+				return 1;
+			}
+		}
+
 		if ( $char =~ /[\w:]/ ) {
 			# Symbol
 			$t->{class} = $t->{token}->set_class( 'Symbol' );
@@ -149,6 +176,21 @@ sub __TOKENIZER__on_char {
 
 
 	} elsif ( $c eq '%' ) {
+		# Postfix dereference: ->%* ->%[...]
+		if ( $char eq '*' || $char eq '[' ) {
+			my ( $prev ) = $t->_previous_significant_tokens(1);
+			if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) {
+				if ( $char eq '*' ) {
+					$t->{class} = $t->{token}->set_class( 'Cast' );
+					return 1;
+				}
+				if ( $char eq '[' ) {
+					$t->{class} = $t->{token}->set_class( 'Cast' );
+					return $t->_finalize_token->__TOKENIZER__on_char( $t );
+				}
+			}
+		}
+
 		# Is it a number?
 		if ( $char =~ /\d/ ) {
 			# bitwise operator
@@ -190,6 +232,15 @@ sub __TOKENIZER__on_char {
 
 
 	} elsif ( $c eq '&' ) {
+		# Postfix dereference: ->&*
+		if ( $char eq '*' ) {
+			my ( $prev ) = $t->_previous_significant_tokens(1);
+			if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) {
+				$t->{class} = $t->{token}->set_class( 'Cast' );
+				return 1;
+			}
+		}
+
 		# Is it a number?
 		if ( $char =~ /\d/ ) {
 			# bitwise operator

t/ppi_token_unknown.t

@@ -463,8 +463,6 @@ OPERATOR_CAST: {
 		]
 	);
 
-{
-	local $TODO = "implement postfix dereference recognition";
 	# Postfix dereference
 
 	test_statement(
@@ -601,7 +599,6 @@ OPERATOR_CAST: {
 			'PPI::Token::Structure' => '}',
 		]
 	);
-}
 
 {   # these need to be fixed in PPI::Lexer->_statement, fixing these will break other tests that need to be changed
 	local $TODO = "clarify type of statement in constructor";