diff --git a/lib/PPI/Token/Data.pm b/lib/PPI/Token/Data.pm index 564161dd..e6a4169c 100644 --- a/lib/PPI/Token/Data.pm +++ b/lib/PPI/Token/Data.pm @@ -80,6 +80,27 @@ sub handle { sub __TOKENIZER__on_line_start { my ( $self, $t ) = @_; + if ( $t->{line} =~ /^__END__\b/ ) { + $t->_new_token( 'Separator', '__END__' ); + $t->_finalize_token; + + $t->{zone} = 'PPI::Token::End'; + + my $end_rest = substr( $t->{line}, 7 ); + if ( length $end_rest ) { + if ( $end_rest =~ /\n$/ ) { + chomp $end_rest; + $t->_new_token( 'Comment', $end_rest ) if length $end_rest; + $t->_new_token( 'Whitespace', "\n" ); + } else { + $t->_new_token( 'Comment', $end_rest ) if length $end_rest; + } + } + $t->_finalize_token; + + return 0; + } + # Add the line if ( defined $t->{token} ) { $t->{token}->{content} .= $t->{line}; diff --git a/t/regression_data_end_pod.t b/t/regression_data_end_pod.t new file mode 100644 index 00000000..c79475ea --- /dev/null +++ b/t/regression_data_end_pod.t @@ -0,0 +1,64 @@ +#!/usr/bin/perl + +# Regression test for GH #16: +# Pod below __END__ not parsed if __DATA__ section is present + +use lib 't/lib'; +use PPI::Test::pragmas; +use Test::More tests => 12 + ($ENV{AUTHOR_TESTING} ? 1 : 0); + +use PPI (); +use Helper 'safe_new'; + +my $code = <<'END_PERL'; +my $x = 1; + +__DATA__ +some data here + +__END__ + +=head1 NAME + +After END pod + +=cut +END_PERL + +my $doc = safe_new \$code; + +{ + my $pods = $doc->find('PPI::Token::Pod'); + ok( $pods, 'found Pod tokens' ); + is( scalar @{ $pods || [] }, 1, 'found exactly one Pod section' ); + like( $pods->[0]->content, qr/After END pod/, 'Pod content from after __END__ is present' ); + + my $seps = $doc->find('PPI::Token::Separator'); + is( scalar @{ $seps || [] }, 2, 'found two Separator tokens (__DATA__ and __END__)' ); + + my $data_tokens = $doc->find('PPI::Token::Data'); + ok( $data_tokens, 'found Data tokens' ); + unlike( $data_tokens->[0]->content, qr/__END__/, + 'Data token does not contain __END__' ); +} + +is( $doc->serialize, $code, 'round-trip preserves original source' ); + +my $code2 = <<'END_PERL'; +my $x = 1; + +__DATA__ +__END__ + +=head1 NAME + +Immediate END after DATA + +=cut +END_PERL + +my $doc2 = safe_new \$code2; +{ + my $pods2 = $doc2->find('PPI::Token::Pod'); + ok( $pods2, 'found Pod when __END__ immediately follows __DATA__' ); +}