issue #31 - DESTROY and AUTOLOAD don't parse as subs without 'sub'

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',

lib/PPI/Statement/Sub.pm

@@ -74,11 +74,19 @@ false.
 =cut
 
 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;
+	my ($self) = @_;
+
+	# Usually the second token is the name.
+	my $token = $self->schild(1);
+	return $token->content
+	  if defined $token and $token->isa('PPI::Token::Word');
+
+	# 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 $token->content
+	  if defined $token and $token->isa('PPI::Token::Word');
+	return '';
 }
 
 =pod

t/ppi_statement_scheduled.t

@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+# Test PPI::Statement::Scheduled
+
+use strict;
+
+BEGIN {
+	$^W = 1;
+	no warnings 'once';
+	$PPI::XS_DISABLE = 1;
+	$PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER};
+}
+
+use Test::More tests => 241;
+use Test::NoWarnings;
+use PPI;
+
+SUB_WORD_OPTIONAL: {
+	for my $name ( qw( BEGIN CHECK UNITCHECK INIT END ) ) {
+		for my $sub ( '', 'sub ' ) {
+
+			# '{}' -- function definition
+			# ';' -- function declaration
+			# '' -- function declaration with missing semicolon
+			for my $followed_by ( ' {}', '{}', ';', '' ) {
+				test_sub_as( $sub, $name, $followed_by );
+			}
+		}
+	}
+}
+
+sub test_sub_as {
+	my ( $sub, $name, $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::Scheduled', "$code: document child is a scheduled statement" );
+	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" );
+	}
+
+	return;
+}

t/ppi_statement_sub.t

@@ -0,0 +1,73 @@
+#!/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 => 119;
+use Test::NoWarnings;
+use PPI;
+
+SUB_WORD_OPTIONAL: {
+	# 'sub' is optional for these special subs. Make sure they're
+	# recognized as subs and sub declarations.
+	for my $name ( qw( AUTOLOAD DESTROY ) ) {
+		for my $sub ( '', 'sub ' ) {
+
+			# '{}' -- function definition
+			# ';' -- function declaration
+			# '' -- function declaration with missing semicolon
+			for my $followed_by ( ' {}', '{}', ';', '' ) {
+				test_sub_as( $sub, $name, $followed_by );
+			}
+		}
+	}
+}
+
+# Through 1.218, the PPI statement AUTOLOAD and DESTROY would
+# gobble up everything after them until it hit an explicit
+# statement terminator. Make sure statements following them are
+# not gobbled.
+my $desc = 'regression: word+block not gobbling to statement terminator';
+for my $word ( qw( AUTOLOAD DESTROY ) ) {
+	my $Document = PPI::Document->new( \"$word {} sub foo {}" );
+	my $statements = $Document->find('Statement::Sub') || [];
+	is( scalar(@$statements), 2, "$desc for $word + sub" );
+
+	$Document = PPI::Document->new( \"$word {} package;" );
+	$statements = $Document->find('Statement::Sub') || [];
+	is( scalar(@$statements), 1, "$desc for $word + package" );
+	$statements = $Document->find('Statement::Package') || [];
+	is( scalar(@$statements), 1, "$desc for $word + package" );
+}
+
+sub test_sub_as {
+	my ( $sub, $name, $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" );
+	}
+
+	return;
+}