diff --git a/lib/PPI/Document.pm b/lib/PPI/Document.pm index 58b6c84b..9b7efa88 100644 --- a/lib/PPI/Document.pm +++ b/lib/PPI/Document.pm @@ -175,6 +175,9 @@ sub new { Carp::croak("API CHANGE: Source code should only be passed to PPI::Document->new as a SCALAR reference"); } + # Save the filename + $attr{filename} ||= $source; + # When loading from a filename, use the caching layer if it exists. if ( $CACHE ) { my $file_contents = PPI::Util::_slurp( $source ); @@ -274,6 +277,7 @@ sub load { sub _setattr { my ($class, $document, %attr) = @_; $document->{readonly} = !! $attr{readonly}; + $document->{filename} = $attr{filename}; return $document; } @@ -339,6 +343,19 @@ sub get_cache { =pod +=head2 filename + +The C accessor returns the name of the file in which the document +is stored. + +=cut + +sub filename { + $_[0]->{filename}; +} + +=pod + =head2 readonly The C attribute indicates if the document is intended to be diff --git a/lib/PPI/Document/File.pm b/lib/PPI/Document/File.pm index e9e568c8..0646d773 100755 --- a/lib/PPI/Document/File.pm +++ b/lib/PPI/Document/File.pm @@ -70,23 +70,9 @@ sub new { die "PPI::Document::File SUPER call returned an object of the wrong type"; } - # Save the filename - $self->{filename} = $filename; - $self; } -=head2 filename - -The C accessor returns the name of the file in which the document -is stored. - -=cut - -sub filename { - $_[0]->{filename}; -} - =pod =head2 save diff --git a/t/29_logical_filename.t b/t/29_logical_filename.t new file mode 100644 index 00000000..504027de --- /dev/null +++ b/t/29_logical_filename.t @@ -0,0 +1,69 @@ +#!/usr/bin/perl + +# Testing of PPI::Element->logical_filename + +use strict; +BEGIN { + no warnings 'once'; + $| = 1; + $PPI::XS_DISABLE = 1; + $PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER}; +} + +use Test::More tests => 21; +use Test::NoWarnings; +use File::Spec::Functions ':ALL'; +use PPI::Document; +use PPI::Document::File; +use PPI::Util (); + + +for my $class ( qw{ PPI::Document PPI::Document::File } ) { + + ##################################################################### + # Actual filename is used until #line directive + + SCOPE: { + my $file = catfile('t', 'data', 'filename.pl'); + ok( -f $file, "$class, test file" ); + + my $doc = $class->new( $file ); + my $items = $doc->find( 'Token::Quote' ); + is( @$items + 0, 2, "$class, number of items" ); + is( $items->[ 0 ]->logical_filename, "$file", "$class, filename" ); + is( $items->[ 1 ]->logical_filename, "moo.pl", "$class, filename" ); + } + + ##################################################################### + # filename attribute overrides actual filename + + SCOPE: { + my $file = catfile('t', 'data', 'filename.pl'); + ok( -f $file, "$class, test file" ); + + my $doc = $class->new( $file, filename => 'assa.pl' ); + my $items = $doc->find( 'Token::Quote' ); + is( @$items + 0, 2, "$class, number of items" ); + my $str = $items->[ 0 ]; + is( $items->[ 0 ]->logical_filename, "assa.pl", "$class, filename" ); + is( $items->[ 1 ]->logical_filename, "moo.pl", "$class, filename" ); + } + +} + +##################################################################### +# filename attribute works for strings too + +SCOPE: { + my $class = 'PPI::Document'; + my $file = catfile('t', 'data', 'filename.pl'); + ok( -f $file, "$class, test file" ); + my $text = PPI::Util::_slurp( $file ); + + my $doc = $class->new( $text, filename => 'tadam.pl' ); + my $items = $doc->find( 'Token::Quote' ); + is( @$items + 0, 2, "$class, number of items" ); + my $str = $items->[ 0 ]; + is( $items->[ 0 ]->logical_filename, "tadam.pl", "$class, filename" ); + is( $items->[ 1 ]->logical_filename, "moo.pl", "$class, filename" ); +} diff --git a/t/data/filename.pl b/t/data/filename.pl new file mode 100644 index 00000000..48dfcea4 --- /dev/null +++ b/t/data/filename.pl @@ -0,0 +1,10 @@ +#!/usr/bin/perl + +if ( 1 ) { + print "Hello World!\n"; +} + +#line 1000 moo.pl +print "Goodbye Blue Sky\n"; + +1;