From 6bc4161cde45481ab12fc2f3ae27899a35ef3f6e Mon Sep 17 00:00:00 2001
From: Christian Walde <walde.christian@gmail.com>
Date: Mon, 26 Dec 2022 09:49:33 +0100
Subject: [PATCH] add support for parsing try/catch under Syntax::Keyword::Try

---
 Changes                       |  2 +
 lib/PPI/Lexer.pm              | 23 +++++++++++-
 lib/PPI/Statement/Compound.pm |  6 ++-
 lib/PPI/Statement/Include.pm  |  4 +-
 t/feature_tracking.t          | 69 ++++++++++++++++++++++++++++++++++-
 5 files changed, 100 insertions(+), 4 deletions(-)

diff --git a/Changes b/Changes
index 44724daa..d6c89ed1 100644
--- a/Changes
+++ b/Changes
@@ -8,9 +8,11 @@ Revision history for Perl extension PPI
 	- Framework for recognition of parsing feature activation via:
 	  - `use $PERL_VERSION` in code
 	  - `use feature` in code
+	  - `use $Common::CPAN::Module` in code
 	  - PPI::Document->new( feature_mods => ... )
 	- Added ability to parse features:
 	  - signatures, as PPI::Structure::Signature
+	  - try catch, as PPI::Statement::Compound
 
 1.279   2024-08-23 14:02:44Z
 	Summary:
diff --git a/lib/PPI/Lexer.pm b/lib/PPI/Lexer.pm
index a82a81b9..fb39e33d 100644
--- a/lib/PPI/Lexer.pm
+++ b/lib/PPI/Lexer.pm
@@ -440,7 +440,12 @@ sub _statement {
 	my $is_lexsub = 0;
 
 	# Is it a token in our known classes list
-	my $class = $STATEMENT_CLASSES{$Token->content};
+	my $class = {
+		%STATEMENT_CLASSES,
+		( try => 'PPI::Statement::Compound' ) x
+		  !!( $Parent->schild(-1) || $Parent )->presumed_features->{try},
+	}->{ $Token->content };
+
 	if ( $class ) {
 		# Is the next significant token a =>
 		# Read ahead to the next significant token
@@ -905,6 +910,22 @@ sub _continues {
 		return $Token->isa('PPI::Token::Structure') && $Token->content eq '{';
 	}
 
+	if ( $type eq 'try' and $LastChild->presumed_features->{try} ) {
+		return 1 if not $LastChild->isa('PPI::Structure::Block');
+
+		my $NextLast = $Statement->schild(-2);
+		return ''
+		  if $NextLast
+		  and $NextLast->isa('PPI::Token')
+		  and $NextLast->isa('PPI::Token::Word')
+		  and $NextLast->content eq 'catch';
+
+		return 1    #
+		  if $Token->isa('PPI::Token::Word') and $Token->content eq 'catch';
+
+		return '';
+	}
+
 	# Handle the common continuable block case
 	if ( $LastChild->isa('PPI::Structure::Block') ) {
 		# LABEL while (EXPR) BLOCK
diff --git a/lib/PPI/Statement/Compound.pm b/lib/PPI/Statement/Compound.pm
index a6595b2d..313aabe3 100644
--- a/lib/PPI/Statement/Compound.pm
+++ b/lib/PPI/Statement/Compound.pm
@@ -128,7 +128,11 @@ sub type {
 		}
 		return 'for';
 	}
-	return $TYPES{$content} if $Element->isa('PPI::Token::Word');
+	return {
+		%TYPES,
+		( try => 'try' ) x !!$self->presumed_features->{try},
+	}->{$content}
+	  if $Element->isa('PPI::Token::Word');
 	return 'continue'       if $Element->isa('PPI::Structure::Block');
 
 	# Unknown (shouldn't exist?)
diff --git a/lib/PPI/Statement/Include.pm b/lib/PPI/Statement/Include.pm
index 8fea3ebc..72589d00 100644
--- a/lib/PPI/Statement/Include.pm
+++ b/lib/PPI/Statement/Include.pm
@@ -259,7 +259,7 @@ sub feature_mods {
 		return { signatures => 1 } if version::parse($perl_version) >= 5.035;
 	}
 
-	my %known = ( signatures => 1 );
+	my %known = ( signatures => 1, try => 1 );
 
 	if ( $self->module eq "feature" ) {
 		my @features = grep $known{$_},
@@ -270,6 +270,8 @@ sub feature_mods {
 		return { map +( $_ => $on_or_off ), @features } if @features;
 	}
 
+	return { try => 1 } if $self->module eq "Syntax::Keyword::Try";
+
 	return;
 }
 
diff --git a/t/feature_tracking.t b/t/feature_tracking.t
index bb50b2fd..6eb43fd1 100644
--- a/t/feature_tracking.t
+++ b/t/feature_tracking.t
@@ -2,7 +2,7 @@
 
 use lib 't/lib';
 use PPI::Test::pragmas;
-use Test::More tests => 3 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 );
+use Test::More tests => 6 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 );
 
 use B 'perlstring';
 
@@ -126,6 +126,73 @@ END_PERL
 	  "disabling of features";
 }
 
+PROTOTYPE_ATTR: {
+	test_document
+	  <<'END_PERL',
+		sub meep :prototype($) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub'   => 'sub meep :prototype($) {}',
+		'PPI::Token::Word'      => 'sub',
+		'PPI::Token::Word'      => 'meep',
+		'PPI::Token::Operator'  => ':',
+		'PPI::Token::Attribute' => 'prototype($)',
+		'PPI::Structure::Block' => '{}',
+		'PPI::Token::Structure' => '{',
+		'PPI::Token::Structure' => '}',
+	  ],
+	  "prototype attribute";
+}
+
+SYNTAX_KEYWORD_TRY: {
+	test_document
+	  <<'END_PERL',
+		use Syntax::Keyword::Try;
+		try{}catch{}
+END_PERL
+	  [
+		'PPI::Statement::Include'  => 'use Syntax::Keyword::Try;',
+		'PPI::Token::Word'         => 'use',
+		'PPI::Token::Word'         => 'Syntax::Keyword::Try',
+		'PPI::Token::Structure'    => ';',
+		'PPI::Statement::Compound' => 'try{}catch{}',
+		'PPI::Token::Word'         => 'try',
+		'PPI::Structure::Block'    => '{}',
+		'PPI::Token::Structure'    => '{',
+		'PPI::Token::Structure'    => '}',
+		'PPI::Token::Word'         => 'catch',
+		'PPI::Structure::Block'    => '{}',
+		'PPI::Token::Structure'    => '{',
+		'PPI::Token::Structure'    => '}',
+	  ],
+	  "Syntax::Keyword::Try";
+}
+
+CORE_TRY: {
+	test_document
+	  <<'END_PERL',
+		use feature "try";
+		try{}catch{}
+END_PERL
+	  [
+		'PPI::Statement::Include'   => 'use feature "try";',
+		'PPI::Token::Word'          => 'use',
+		'PPI::Token::Word'          => 'feature',
+		'PPI::Token::Quote::Double' => '"try"',
+		'PPI::Token::Structure'     => ';',
+		'PPI::Statement::Compound'  => 'try{}catch{}',
+		'PPI::Token::Word'          => 'try',
+		'PPI::Structure::Block'     => '{}',
+		'PPI::Token::Structure'     => '{',
+		'PPI::Token::Structure'     => '}',
+		'PPI::Token::Word'          => 'catch',
+		'PPI::Structure::Block'     => '{}',
+		'PPI::Token::Structure'     => '{',
+		'PPI::Token::Structure'     => '}',
+	  ],
+	  "core try";
+}
+
 ### TODO from ppi_token_unknown.t , deduplicate
 
 sub one_line_explain {