issue Perl-Critic#31 - DESTROY and AUTOLOAD don't parse as subs witho…

…ut 'sub'
moregan · Mar 15, 2014 · b9e3981 · b9e3981
1 parent 3208e1f
commit b9e3981
Show file tree

Hide file tree

Showing 4 changed files with 100 additions and 5 deletions.
diff --git a/lib/PPI/Lexer.pm b/lib/PPI/Lexer.pm
@@ -353,6 +353,10 @@ BEGIN {
 		'INIT'      => 'PPI::Statement::Scheduled',
 		'END'       => 'PPI::Statement::Scheduled',
 
+		# Special subroutines for which 'sub' is optional
+		'AUTOLOAD'  => 'PPI::Statement::Sub',
+		'DESTROY'   => 'PPI::Statement::Sub',
+
 		# Loading and context statement
 		'package'   => 'PPI::Statement::Package',
 		# 'use'       => 'PPI::Statement::Include',

diff --git a/lib/PPI/Statement/Sub.pm b/lib/PPI/Statement/Sub.pm
@@ -76,9 +76,16 @@ false.
 sub name {
 	my $self = shift;
 
-	# The second token should be the name, if we have one
-	my $Token = $self->schild(1) or return '';
-	$Token->isa('PPI::Token::Word') and $Token->content;
+	# Usually the second token is the name.
+	my $Token = $self->schild(1);
+	if ( defined $Token && $Token->isa('PPI::Token::Word') ) {
+		return $Token->content;
+	}
+
+	# In the case of special subs whose 'sub' can be omitted (AUTOLOAD
+	# or DESTROY), the name will be the first token.
+	$Token = $self->schild(0);
+	return (defined $Token && $Token->isa('PPI::Token::Word')) ? $Token->content : '';
 }
 
 =pod

diff --git a/t/ppi_statement.t b/t/ppi_statement.t
@@ -10,7 +10,8 @@ BEGIN {
 	$PPI::XS_DISABLE = 1;
 	$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
 }
-use Test::More tests => 23;
+
+use Test::More tests => 49;
 use Test::NoWarnings;
 use PPI;
 
@@ -25,12 +26,25 @@ BEGIN { }
 sub foo { }
 state $x;
 $x = 5;
+sub BEGIN { }
+CHECK {}
+sub CHECK {}
+UNITCHECK {}
+sub UNITCHECK {}
+INIT {}
+sub INIT {}
+END {}
+sub END {}
+AUTOLOAD {}
+sub AUTOLOAD {}
+DESTROY {}
+sub DESTROY {}
 END_PERL
 
 	isa_ok( $Document, 'PPI::Document' );
 
 	my $statements = $Document->find('Statement');
-	is( scalar @{$statements}, 10, 'Found the 10 test statements' );
+	is( scalar @{$statements}, 23, 'Found the 23 test statements' );
 
 	isa_ok( $statements->[0], 'PPI::Statement::Package',    'Statement 1: isa Package'            );
 	ok( $statements->[0]->specialized,                      'Statement 1: is specialized'         );
@@ -52,4 +66,30 @@ END_PERL
 	ok( $statements->[8]->specialized,                      'Statement 9: is specialized'         );
 	is( ref $statements->[9], 'PPI::Statement',             'Statement 10: is a simple Statement' );
 	ok( ! $statements->[9]->specialized,                    'Statement 10: is not specialized'    );
+	isa_ok( $statements->[10], 'PPI::Statement::Scheduled', 'Statement 11: isa Scheduled'         );
+	ok( $statements->[10]->specialized,                     'Statement 11: is specialized'        );
+	isa_ok( $statements->[11], 'PPI::Statement::Scheduled', 'Statement 12: isa Scheduled'         );
+	ok( $statements->[11]->specialized,                     'Statement 12: is specialized'        );
+	isa_ok( $statements->[12], 'PPI::Statement::Scheduled', 'Statement 13: isa Scheduled'         );
+	ok( $statements->[12]->specialized,                     'Statement 13: is specialized'        );
+	isa_ok( $statements->[13], 'PPI::Statement::Scheduled', 'Statement 14: isa Scheduled'         );
+	ok( $statements->[13]->specialized,                     'Statement 14: is specialized'        );
+	isa_ok( $statements->[14], 'PPI::Statement::Scheduled', 'Statement 15: isa Scheduled'         );
+	ok( $statements->[14]->specialized,                     'Statement 15: is specialized'        );
+	isa_ok( $statements->[15], 'PPI::Statement::Scheduled', 'Statement 16: isa Scheduled'         );
+	ok( $statements->[15]->specialized,                     'Statement 16: is specialized'        );
+	isa_ok( $statements->[16], 'PPI::Statement::Scheduled', 'Statement 17: isa Scheduled'         );
+	ok( $statements->[16]->specialized,                     'Statement 17: is specialized'        );
+	isa_ok( $statements->[17], 'PPI::Statement::Scheduled', 'Statement 18: isa Scheduled'         );
+	ok( $statements->[17]->specialized,                     'Statement 18: is specialized'        );
+	isa_ok( $statements->[18], 'PPI::Statement::Scheduled', 'Statement 19: isa Scheduled'         );
+	ok( $statements->[18]->specialized,                     'Statement 19: is specialized'        );
+	isa_ok( $statements->[19], 'PPI::Statement::Sub', 	'Statement 20: isa Scheduled'         );
+	ok( $statements->[19]->specialized,                     'Statement 20: is specialized'        );
+	isa_ok( $statements->[20], 'PPI::Statement::Sub', 	'Statement 21: isa Scheduled'         );
+	ok( $statements->[20]->specialized,                     'Statement 21: is specialized'        );
+	isa_ok( $statements->[21], 'PPI::Statement::Sub', 	'Statement 22: isa Scheduled'         );
+	ok( $statements->[21]->specialized,                     'Statement 22: is specialized'        );
+	isa_ok( $statements->[22], 'PPI::Statement::Sub', 	'Statement 23: isa Scheduled'         );
+	ok( $statements->[22]->specialized,                     'Statement 23: is specialized'        );
 }
diff --git a/t/ppi_statement_sub.t b/t/ppi_statement_sub.t
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+# Test PPI::Statement::Sub
+
+use strict;
+BEGIN {
+	$^W = 1;
+	no warnings 'once';
+	$PPI::XS_DISABLE = 1;
+	$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
+}
+
+use Test::More tests => 113;
+use Test::NoWarnings;
+use PPI;
+
+
+SUB_WORD_OPTIONAL: {
+	foreach my $name ( qw( AUTOLOAD DESTROY ) ) {
+		foreach my $sub ( '', 'sub ' ) {
+			# '{}' -- function definition
+			# ';' -- function declaration
+			# '' -- function declaration with missing semicolon
+			foreach my $followed_by ( ' {}', '{}', ';', '' ) {
+				my $code = "$sub$name$followed_by";
+				my $Document = PPI::Document->new( \$code );
+				isa_ok( $Document, 'PPI::Document', "$code: got document" );
+
+				my ( $sub_statement, $dummy ) = $Document->schildren();
+				isa_ok( $sub_statement, 'PPI::Statement::Sub', "$code: document child is a sub" );
+				isnt( ref $sub_statement, 'PPI::Statement::Scheduled', "$code: not a PPI::Statement::Scheduled" );
+				is( $dummy, undef, "$code: document has exactly one child" );
+				ok( $sub_statement->reserved(), "$code: is reserved" );
+				is( $sub_statement->name(), $name, "$code: name() correct" );
+				if ( $followed_by =~ /}/ ) {
+					isa_ok( $sub_statement->block(), 'PPI::Structure::Block', "$code: has a block" );
+				}
+				else {
+					ok( !$sub_statement->block(), "$code: has no block" );
+				}
+			}
+		}
+	}
+}