From b45bce28bae932a61b51b98f3c60faaac56fec68 Mon Sep 17 00:00:00 2001
From: Christian Walde <walde.christian@gmail.com>
Date: Tue, 19 Nov 2024 12:34:48 +0100
Subject: [PATCH] implement Structure::Signature

---
 Changes                        |   2 +-
 lib/PPI/Lexer.pm               |   2 +
 lib/PPI/Structure.pm           |   1 +
 lib/PPI/Structure/Signature.pm |  61 +++++
 lib/PPI/Token.pm               |   1 -
 lib/PPI/Token/Signature.pm     |  55 ----
 lib/PPI/Token/Unknown.pm       |  27 ++
 lib/PPI/Token/Whitespace.pm    |  17 +-
 lib/PPI/Tokenizer.pm           |  19 ++
 prot.pl                        |   6 +
 t/feature_tracking.t           | 218 +++++++++-------
 t/signature_details.t          | 459 +++++++++++++++++++++++++++++++++
 12 files changed, 708 insertions(+), 160 deletions(-)
 create mode 100644 lib/PPI/Structure/Signature.pm
 delete mode 100644 lib/PPI/Token/Signature.pm
 create mode 100644 prot.pl
 create mode 100644 t/signature_details.t

diff --git a/Changes b/Changes
index 238b1237..00d158b0 100644
--- a/Changes
+++ b/Changes
@@ -13,7 +13,7 @@ Revision history for Perl extension PPI
 	  - PPI::Document->new( custom_feature_includes => ... )
 	  - PPI::Document->new( custom_feature_include_cb => ... )
 	- Added ability to parse features:
-	  - signatures, as PPI::Token::Signature
+	  - signatures, as PPI::Structure::Signature
 	  - try catch, as PPI::Statement::Compound
 
 1.279   2024-08-23 14:02:44Z
diff --git a/lib/PPI/Lexer.pm b/lib/PPI/Lexer.pm
index 3993a2fd..fb39e33d 100644
--- a/lib/PPI/Lexer.pm
+++ b/lib/PPI/Lexer.pm
@@ -1065,6 +1065,8 @@ sub _round {
 		return 'PPI::Structure::Given';
 	} elsif ( $Parent->isa('PPI::Statement::When') ) {
 		return 'PPI::Structure::When';
+	} elsif ( $Parent->isa('PPI::Statement::Sub') ) {
+		return 'PPI::Structure::Signature';
 	}
 
 	# Otherwise, it must be a list
diff --git a/lib/PPI/Structure.pm b/lib/PPI/Structure.pm
index ab745459..e7f9ae72 100644
--- a/lib/PPI/Structure.pm
+++ b/lib/PPI/Structure.pm
@@ -108,6 +108,7 @@ use PPI::Structure::List        ();
 use PPI::Structure::Subscript   ();
 use PPI::Structure::Unknown     ();
 use PPI::Structure::When        ();
+use PPI::Structure::Signature   ();
 
 
 
diff --git a/lib/PPI/Structure/Signature.pm b/lib/PPI/Structure/Signature.pm
new file mode 100644
index 00000000..ed24d130
--- /dev/null
+++ b/lib/PPI/Structure/Signature.pm
@@ -0,0 +1,61 @@
+package PPI::Structure::Signature;
+
+=pod
+
+=head1 NAME
+
+PPI::Structure::Signature - List of subroutine signature elements
+
+=head1 SYNOPSIS
+
+  sub do_thing( $param, $arg ) {}
+
+=head1 INHERITANCE
+
+  PPI::Structure::Signature
+    isa PPI::Structure::List
+        isa PPI::Structure
+            isa PPI::Node
+                isa PPI::Element
+
+=head1 DESCRIPTION
+
+C<PPI::Structure::Signature> is the class used for circular braces that
+represent lists of signature elements.
+
+=head1 METHODS
+
+C<PPI::Structure::Signature> has no methods beyond those provided by the
+standard L<PPI::Structure::List>, L<PPI::Structure>, L<PPI::Node> and
+L<PPI::Element> methods.
+
+=cut
+
+use strict;
+use PPI::Structure ();
+
+our $VERSION = '1.277';
+
+our @ISA = "PPI::Structure::List";
+
+1;
+
+=head1 SUPPORT
+
+See the L<support section|PPI/SUPPORT> in the main module.
+
+=head1 AUTHOR
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2001 - 2011 Adam Kennedy.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
diff --git a/lib/PPI/Token.pm b/lib/PPI/Token.pm
index 9b5af05e..5fa7ca4e 100644
--- a/lib/PPI/Token.pm
+++ b/lib/PPI/Token.pm
@@ -70,7 +70,6 @@ use PPI::Token::Separator             ();
 use PPI::Token::Data                  ();
 use PPI::Token::End                   ();
 use PPI::Token::Prototype             ();
-use PPI::Token::Signature             ();
 use PPI::Token::Attribute             ();
 use PPI::Token::Unknown               ();
 
diff --git a/lib/PPI/Token/Signature.pm b/lib/PPI/Token/Signature.pm
deleted file mode 100644
index 0ecf8556..00000000
--- a/lib/PPI/Token/Signature.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package PPI::Token::Signature;
-
-=pod
-
-=head1 NAME
-
-PPI::Token::Signature - A subroutine signature descriptor
-
-=head1 INHERITANCE
-
-  PPI::Token::Signature
-  isa PPI::Token::Prototype
-      isa PPI::Token
-          isa PPI::Element
-
-=head1 SYNOPSIS
-
-  TODO: document
-
-=head1 DESCRIPTION
-
-  TODO: document
-
-=cut
-
-use strict;
-use PPI::Token::Prototype ();
-
-our $VERSION = '1.276';
-
-our @ISA = "PPI::Token::Prototype";
-
-1;
-
-=pod
-
-=head1 SUPPORT
-
-See the L<support section|PPI/SUPPORT> in the main module.
-
-=head1 AUTHOR
-
-Adam Kennedy E<lt>adamk@cpan.orgE<gt>
-
-=head1 COPYRIGHT
-
-Copyright 2001 - 2011 Adam Kennedy.
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=cut
diff --git a/lib/PPI/Token/Unknown.pm b/lib/PPI/Token/Unknown.pm
index b1597b42..bf528c21 100644
--- a/lib/PPI/Token/Unknown.pm
+++ b/lib/PPI/Token/Unknown.pm
@@ -115,6 +115,15 @@ sub __TOKENIZER__on_char {
 			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;
+			if ($has_sig) {
+				$t->{class} = $t->{token}->set_class('Symbol');
+				return $t->_finalize_token->__TOKENIZER__on_char($t);
+			}
+		}
+
 		if ( $MAGIC{ $c . $char } ) {
 			# Magic variable
 			$t->{class} = $t->{token}->set_class( 'Magic' );
@@ -153,6 +162,15 @@ sub __TOKENIZER__on_char {
 			return 1;
 		}
 
+		# Is it a nameless arg in a signature?
+		if ( $char eq ')' ) {
+			my ($has_sig) = $t->_current_token_has_signatures_active;
+			if ($has_sig) {
+				$t->{class} = $t->{token}->set_class('Symbol');
+				return $t->_finalize_token->__TOKENIZER__on_char($t);
+			}
+		}
+
 		if ( $MAGIC{ $c . $char } ) {
 			# Magic variable
 			$t->{class} = $t->{token}->set_class( 'Magic' );
@@ -198,6 +216,15 @@ sub __TOKENIZER__on_char {
 			return $t->_finalize_token->__TOKENIZER__on_char( $t );
 		}
 
+		# Is it a nameless arg in a signature?
+		if ( $char eq ')' ) {
+			my ($has_sig) = $t->_current_token_has_signatures_active;
+			if ($has_sig) {
+				$t->{class} = $t->{token}->set_class('Symbol');
+				return $t->_finalize_token->__TOKENIZER__on_char($t);
+			}
+		}
+
 		# Is it a magic variable?
 		if ( $char eq '^' || $MAGIC{ $c . $char } ) {
 			$t->{class} = $t->{token}->set_class( 'Magic' );
diff --git a/lib/PPI/Token/Whitespace.pm b/lib/PPI/Token/Whitespace.pm
index 0b7a1ac8..b77ba7e6 100644
--- a/lib/PPI/Token/Whitespace.pm
+++ b/lib/PPI/Token/Whitespace.pm
@@ -212,21 +212,8 @@ sub __TOKENIZER__on_char {
 		# 2. The one before that is the word 'sub'.
 		# 3. The one before that is a 'structure'
 
-		# Get at least the three previous significant tokens, and extend the
-		# retrieval range to include at least one token that can walk the
-		# already generated tree. (i.e. has a parent)
-		my ( $tokens_to_get, @tokens ) = (3);
-		while ( !@tokens or ( $tokens[-1] and !$tokens[-1]->parent ) ) {
-			@tokens = $t->_previous_significant_tokens($tokens_to_get);
-			last if @tokens < $tokens_to_get;
-			$tokens_to_get++;
-		}
-
-		my ($closest_parented_token) = grep $_->parent, @tokens;
-		die "no parented element found" unless    #
-		  $closest_parented_token ||= $t->_document;
-		return 'Signature'
-		  if $closest_parented_token->presumed_features->{signatures};
+		my ( $has_sig, @tokens ) = $t->_current_token_has_signatures_active;
+		return 'Structure' if $has_sig;
 
 		# A normal subroutine declaration
 		my $p1 = $tokens[1];
diff --git a/lib/PPI/Tokenizer.pm b/lib/PPI/Tokenizer.pm
index c19c3436..cf96355d 100644
--- a/lib/PPI/Tokenizer.pm
+++ b/lib/PPI/Tokenizer.pm
@@ -858,6 +858,25 @@ sub __current_token_is_forced_word {
 	return '';
 }
 
+sub _current_token_has_signatures_active {
+	my ($t) = @_;
+
+	# Get at least the three previous significant tokens, and extend the
+	# retrieval range to include at least one token that can walk the
+	# already generated tree. (i.e. has a parent)
+	my ( $tokens_to_get, @tokens ) = (3);
+	while ( !@tokens or ( $tokens[-1] and !$tokens[-1]->parent ) ) {
+		@tokens = $t->_previous_significant_tokens($tokens_to_get);
+		last if @tokens < $tokens_to_get;
+		$tokens_to_get++;
+	}
+
+	my ($closest_parented_token) = grep $_->parent, @tokens;
+	die "no parented element found" unless    #
+	  $closest_parented_token ||= $t->_document;
+	return $closest_parented_token->presumed_features->{signatures}, @tokens;
+}
+
 1;
 
 =pod
diff --git a/prot.pl b/prot.pl
new file mode 100644
index 00000000..b09743d4
--- /dev/null
+++ b/prot.pl
@@ -0,0 +1,6 @@
+sub prot(
+		 (
+		  a
+		  \\
+		  )
+		 ){} prot(1)
diff --git a/t/feature_tracking.t b/t/feature_tracking.t
index 5cb9b300..24c473e9 100644
--- a/t/feature_tracking.t
+++ b/t/feature_tracking.t
@@ -7,6 +7,7 @@ use Test::More tests => 8 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 );
 use B 'perlstring';
 
 use PPI ();
+use PPI::Dumper;
 
 #use DB::Skip subs => [
 #	qw( PPI::Document::new  PPI::Lexer::lex_source  PPI::Lexer::new
@@ -25,24 +26,30 @@ FEATURE_TRACKING: {
 		sub marp($left, $right) {}
 END_PERL
 	  [
-		'PPI::Statement::Sub'       => 'sub meep($) {}',
-		'PPI::Token::Word'          => 'sub',
-		'PPI::Token::Word'          => 'meep',
-		'PPI::Token::Prototype'     => '($)',
-		'PPI::Structure::Block'     => '{}',
-		'PPI::Token::Structure'     => '{',
-		'PPI::Token::Structure'     => '}',
-		'PPI::Statement::Include'   => 'use 5.035;',
-		'PPI::Token::Word'          => 'use',
-		'PPI::Token::Number::Float' => '5.035',
-		'PPI::Token::Structure'     => ';',
-		'PPI::Statement::Sub'       => 'sub marp($left, $right) {}',
-		'PPI::Token::Word'          => 'sub',
-		'PPI::Token::Word'          => 'marp',
-		'PPI::Token::Signature'     => '($left, $right)', # !!!!!!!!!!!!!!!!!!!!
-		'PPI::Structure::Block'     => '{}',
-		'PPI::Token::Structure'     => '{',
-		'PPI::Token::Structure'     => '}',
+		'PPI::Statement::Sub',        'sub meep($) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'meep',
+		'PPI::Token::Prototype',      '($)',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+		'PPI::Statement::Include',    'use 5.035;',
+		'PPI::Token::Word',           'use',
+		'PPI::Token::Number::Float',  '5.035',
+		'PPI::Token::Structure',      ';',
+		'PPI::Statement::Sub',        'sub marp($left, $right) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'marp',
+		'PPI::Structure::Signature',  '($left, $right)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$left, $right',
+		'PPI::Token::Symbol',         '$left',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$right',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}'
 	  ],
 	  "enabling of features";
 }
@@ -55,20 +62,30 @@ DOCUMENT_FEATURES: {
 		sub marp($left, $right) {}
 END_PERL
 	  [
-		'PPI::Statement::Sub'   => 'sub meep($) {}',
-		'PPI::Token::Word'      => 'sub',
-		'PPI::Token::Word'      => 'meep',
-		'PPI::Token::Signature' => '($)',
-		'PPI::Structure::Block' => '{}',
-		'PPI::Token::Structure' => '{',
-		'PPI::Token::Structure' => '}',
-		'PPI::Statement::Sub'   => 'sub marp($left, $right) {}',
-		'PPI::Token::Word'      => 'sub',
-		'PPI::Token::Word'      => 'marp',
-		'PPI::Token::Signature' => '($left, $right)',
-		'PPI::Structure::Block' => '{}',
-		'PPI::Token::Structure' => '{',
-		'PPI::Token::Structure' => '}',
+		'PPI::Statement::Sub',        'sub meep($) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'meep',
+		'PPI::Structure::Signature',  '($)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$',
+		'PPI::Token::Symbol',         '$',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+		'PPI::Statement::Sub',        'sub marp($left, $right) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'marp',
+		'PPI::Structure::Signature',  '($left, $right)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$left, $right',
+		'PPI::Token::Symbol',         '$left',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$right',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
 	  ],
 	  "document-level default features";
 }
@@ -82,25 +99,29 @@ DISABLE_FEATURE: {
 		sub marp($left, $right) {}
 END_PERL
 	  [
-		'PPI::Statement::Sub'       => 'sub meep($) {}',
-		'PPI::Token::Word'          => 'sub',
-		'PPI::Token::Word'          => 'meep',
-		'PPI::Token::Signature'     => '($)',
-		'PPI::Structure::Block'     => '{}',
-		'PPI::Token::Structure'     => '{',
-		'PPI::Token::Structure'     => '}',
-		'PPI::Statement::Include'   => q|no feature 'signatures';|,
-		'PPI::Token::Word'          => 'no',
-		'PPI::Token::Word'          => 'feature',
-		'PPI::Token::Quote::Single' => q|'signatures'|,
-		'PPI::Token::Structure'     => ';',
-		'PPI::Statement::Sub'       => 'sub marp($left, $right) {}',
-		'PPI::Token::Word'          => 'sub',
-		'PPI::Token::Word'          => 'marp',
-		'PPI::Token::Prototype'     => '($left, $right)',
-		'PPI::Structure::Block'     => '{}',
-		'PPI::Token::Structure'     => '{',
-		'PPI::Token::Structure'     => '}',
+		'PPI::Statement::Sub',        'sub meep($) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'meep',
+		'PPI::Structure::Signature',  '($)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$',
+		'PPI::Token::Symbol',         '$',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+		'PPI::Statement::Include',    'no feature \'signatures\';',
+		'PPI::Token::Word',           'no',
+		'PPI::Token::Word',           'feature',
+		'PPI::Token::Quote::Single',  '\'signatures\'',
+		'PPI::Token::Structure',      ';',
+		'PPI::Statement::Sub',        'sub marp($left, $right) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'marp',
+		'PPI::Token::Prototype',      '($left, $right)',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
 	  ],
 	  "disabling of features";
 }
@@ -181,24 +202,34 @@ HOMEBREW_ARGS: {
 		sub marp($left, $right) {}
 END_PERL
 	  [
-		'PPI::Statement::Include' => 'use strEct;',
-		'PPI::Token::Word'        => 'use',
-		'PPI::Token::Word'        => 'strEct',
-		'PPI::Token::Structure'   => ';',
-		'PPI::Statement::Sub'     => 'sub meep($) {}',
-		'PPI::Token::Word'        => 'sub',
-		'PPI::Token::Word'        => 'meep',
-		'PPI::Token::Signature'   => '($)',
-		'PPI::Structure::Block'   => '{}',
-		'PPI::Token::Structure'   => '{',
-		'PPI::Token::Structure'   => '}',
-		'PPI::Statement::Sub'     => 'sub marp($left, $right) {}',
-		'PPI::Token::Word'        => 'sub',
-		'PPI::Token::Word'        => 'marp',
-		'PPI::Token::Signature'   => '($left, $right)',
-		'PPI::Structure::Block'   => '{}',
-		'PPI::Token::Structure'   => '{',
-		'PPI::Token::Structure'   => '}',
+		'PPI::Statement::Include',    'use strEct;',
+		'PPI::Token::Word',           'use',
+		'PPI::Token::Word',           'strEct',
+		'PPI::Token::Structure',      ';',
+		'PPI::Statement::Sub',        'sub meep($) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'meep',
+		'PPI::Structure::Signature',  '($)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$',
+		'PPI::Token::Symbol',         '$',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+		'PPI::Statement::Sub',        'sub marp($left, $right) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'marp',
+		'PPI::Structure::Signature',  '($left, $right)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$left, $right',
+		'PPI::Token::Symbol',         '$left',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$right',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
 	  ],
 	  "simple custom boilerplate modules";
 }
@@ -220,25 +251,35 @@ HOMEBREW_CB: {
 		sub marp($left, $right) {}
 END_PERL
 	  [
-		'PPI::Statement::Include'   => 'use strEct "sigg";',
-		'PPI::Token::Word'          => 'use',
-		'PPI::Token::Word'          => 'strEct',
-		'PPI::Token::Quote::Double' => '"sigg"',
-		'PPI::Token::Structure'     => ';',
-		'PPI::Statement::Sub'       => 'sub meep($) {}',
-		'PPI::Token::Word'          => 'sub',
-		'PPI::Token::Word'          => 'meep',
-		'PPI::Token::Signature'     => '($)',
-		'PPI::Structure::Block'     => '{}',
-		'PPI::Token::Structure'     => '{',
-		'PPI::Token::Structure'     => '}',
-		'PPI::Statement::Sub'       => 'sub marp($left, $right) {}',
-		'PPI::Token::Word'          => 'sub',
-		'PPI::Token::Word'          => 'marp',
-		'PPI::Token::Signature'     => '($left, $right)',
-		'PPI::Structure::Block'     => '{}',
-		'PPI::Token::Structure'     => '{',
-		'PPI::Token::Structure'     => '}',
+		'PPI::Statement::Include',    'use strEct "sigg";',
+		'PPI::Token::Word',           'use',
+		'PPI::Token::Word',           'strEct',
+		'PPI::Token::Quote::Double',  '"sigg"',
+		'PPI::Token::Structure',      ';',
+		'PPI::Statement::Sub',        'sub meep($) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'meep',
+		'PPI::Structure::Signature',  '($)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$',
+		'PPI::Token::Symbol',         '$',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+		'PPI::Statement::Sub',        'sub marp($left, $right) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'marp',
+		'PPI::Structure::Signature',  '($left, $right)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$left, $right',
+		'PPI::Token::Symbol',         '$left',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$right',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
 	  ],
 	  "callback for complex custom boilerplate modules";
 }
@@ -275,6 +316,7 @@ sub test_document {
 	my $ok = is_deeply( $tokens, $expected, main_level_line . $msg );
 	if ( !$ok ) {
 		diag ">>> $code -- $msg\n";
+		diag( PPI::Dumper->new($d)->string );
 		diag one_line_explain $tokens;
 		diag one_line_explain $expected;
 	}
diff --git a/t/signature_details.t b/t/signature_details.t
new file mode 100644
index 00000000..c2fc9802
--- /dev/null
+++ b/t/signature_details.t
@@ -0,0 +1,459 @@
+#!/usr/bin/perl
+
+use lib 't/lib';
+use PPI::Test::pragmas;
+use Test::More tests => 16 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 );
+
+use B 'perlstring';
+
+use PPI ();
+use PPI::Dumper;
+
+sub test_document;
+
+BASE_SIGNATURE_EXAMPLE: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($left, $right) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($left, $right) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($left, $right)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$left, $right',
+		'PPI::Token::Symbol',         '$left',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$right',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "base signature example";
+}
+
+UNNAMED_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($first, $, $third) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($first, $, $third) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($first, $, $third)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$first, $, $third',
+		'PPI::Token::Symbol',         '$first',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$third',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "unnamed argument";
+}
+
+POSITIONAL_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($left, $right = 0) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($left, $right = 0) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($left, $right = 0)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$left, $right = 0',
+		'PPI::Token::Symbol',         '$left',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$right',
+		'PPI::Token::Operator',       '=',
+		'PPI::Token::Number',         '0',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "positional argument";
+}
+
+INCREMENT_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($thing, $id = $auto_id++) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($thing, $id = $auto_id++) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($thing, $id = $auto_id++)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$thing, $id = $auto_id++',
+		'PPI::Token::Symbol',         '$thing',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$id',
+		'PPI::Token::Operator',       '=',
+		'PPI::Token::Symbol',         '$auto_id',
+		'PPI::Token::Operator',       '++',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "increment argument";
+}
+
+DEFAULT_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($first_name, $surname, $nickname = $first_name) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub' =>
+		  'sub foo ($first_name, $surname, $nickname = $first_name) {}',    #
+		'PPI::Token::Word', 'sub',
+		'PPI::Token::Word', 'foo',
+		'PPI::Structure::Signature' =>
+		  '($first_name, $surname, $nickname = $first_name)',
+		'PPI::Token::Structure', '(',
+		'PPI::Statement::Expression' =>
+		  '$first_name, $surname, $nickname = $first_name',
+		'PPI::Token::Symbol',    '$first_name',
+		'PPI::Token::Operator',  ',',
+		'PPI::Token::Symbol',    '$surname',
+		'PPI::Token::Operator',  ',',
+		'PPI::Token::Symbol',    '$nickname',
+		'PPI::Token::Operator',  '=',
+		'PPI::Token::Symbol',    '$first_name',
+		'PPI::Token::Structure', ')',
+		'PPI::Structure::Block', '{}',
+		'PPI::Token::Structure', '{',
+		'PPI::Token::Structure', '}',
+	  ],
+	  "default argument";
+}
+
+UNDEF_DEFAULT_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($name //= "world") {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($name //= "world") {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($name //= "world")',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$name //= "world"',
+		'PPI::Token::Symbol',         '$name',
+		'PPI::Token::Operator',       '//=',
+		'PPI::Token::Quote::Double',  '"world"',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "undef default argument";
+}
+
+OR_DEFAULT_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($name ||= "world") {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($name ||= "world") {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($name ||= "world")',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$name ||= "world"',
+		'PPI::Token::Symbol',         '$name',
+		'PPI::Token::Operator',       '||=',
+		'PPI::Token::Quote::Double',  '"world"',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "or default argument";
+}
+
+NAMELESS_OPTIONAL_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($thing, $ = 1) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($thing, $ = 1) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($thing, $ = 1)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$thing, $ = 1',
+		'PPI::Token::Symbol',         '$thing',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Cast',           '$',
+		'PPI::Token::Operator',       '=',
+		'PPI::Token::Number',         '1',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "nameless optional argument";
+}
+
+VALUELESS_OPTIONAL_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($thing, $=) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($thing, $=) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($thing, $=)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$thing, $=',
+		'PPI::Token::Symbol',         '$thing',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$',
+		'PPI::Token::Operator',       '=',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "valueless optional argument";
+}
+
+SLURPY_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($filter, @inputs) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($filter, @inputs) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($filter, @inputs)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$filter, @inputs',
+		'PPI::Token::Symbol',         '$filter',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '@inputs',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "slurpy argument";
+}
+
+NAMELESS_SLURPY_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($thing, @) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($thing, @) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($thing, @)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$thing, @',
+		'PPI::Token::Symbol',         '$thing',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '@',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "nameless slurpy argument";
+}
+
+SLURPY_HASH_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($filter, %inputs) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($filter, %inputs) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($filter, %inputs)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$filter, %inputs',
+		'PPI::Token::Symbol',         '$filter',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '%inputs',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "slurpy hash argument";
+}
+
+NAMELESS_SLURPY_HASH_ARGUMENT: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo ($thing, %) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',        'sub foo ($thing, %) {}',
+		'PPI::Token::Word',           'sub',
+		'PPI::Token::Word',           'foo',
+		'PPI::Structure::Signature',  '($thing, %)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$thing, %',
+		'PPI::Token::Symbol',         '$thing',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '%',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "nameless slurpy hash argument";
+}
+
+EMPTY_SIGNATURE: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo () {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',       'sub foo () {}',
+		'PPI::Token::Word',          'sub',
+		'PPI::Token::Word',          'foo',
+		'PPI::Structure::Signature', '()',
+		'PPI::Token::Structure',     '(',
+		'PPI::Token::Structure',     ')',
+		'PPI::Structure::Block',     '{}',
+		'PPI::Token::Structure',     '{',
+		'PPI::Token::Structure',     '}',
+	  ],
+	  "empty signature";
+}
+
+PROTOTYPE_SIGNATURE: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo :prototype($$) ($left, $right) {}
+END_PERL
+	  [
+		'PPI::Statement::Sub',   'sub foo :prototype($$) ($left, $right) {}',  #
+		'PPI::Token::Word',      'sub',
+		'PPI::Token::Word',      'foo',
+		'PPI::Token::Operator',  ':',
+		'PPI::Token::Attribute', 'prototype($$)',
+		'PPI::Structure::Signature',  '($left, $right)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$left, $right',
+		'PPI::Token::Symbol',         '$left',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$right',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{}',
+		'PPI::Token::Structure',      '{',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "prototype signature";
+}
+
+COMPLEX_SIGNATURE_EXAMPLE: {
+	test_document
+	  [ feature_mods => { signatures => 1 } ],
+	  <<'END_PERL',
+		sub foo :lvalue ($x, $y = 1, @z) { ... }
+END_PERL
+	  [
+		'PPI::Statement::Sub',   'sub foo :lvalue ($x, $y = 1, @z) { ... }',   #
+		'PPI::Token::Word',      'sub',
+		'PPI::Token::Word',      'foo',
+		'PPI::Token::Operator',  ':',
+		'PPI::Token::Attribute', 'lvalue',
+		'PPI::Structure::Signature',  '($x, $y = 1, @z)',
+		'PPI::Token::Structure',      '(',
+		'PPI::Statement::Expression', '$x, $y = 1, @z',
+		'PPI::Token::Symbol',         '$x',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '$y',
+		'PPI::Token::Operator',       '=',
+		'PPI::Token::Number',         '1',
+		'PPI::Token::Operator',       ',',
+		'PPI::Token::Symbol',         '@z',
+		'PPI::Token::Structure',      ')',
+		'PPI::Structure::Block',      '{ ... }',
+		'PPI::Token::Structure',      '{',
+		'PPI::Statement',             '...',
+		'PPI::Token::Operator',       '...',
+		'PPI::Token::Structure',      '}',
+	  ],
+	  "complex signature example";
+}
+
+### TODO from ppi_token_unknown.t , deduplicate
+
+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 die explain $@;
+	my $tokens = $d->find( sub { $_[1]->significant } );
+	$tokens = [ map { ref($_), $_->content } @$tokens ];
+
+	my $ok = is_deeply( $tokens, $expected, main_level_line . $msg );
+	if ( !$ok ) {
+		diag ">>> $code -- $msg\n";
+		diag( PPI::Dumper->new($d)->string );
+		diag one_line_explain $tokens;
+		diag one_line_explain $expected;
+	}
+
+	return;
+}