From c83d0738a9b9280ae49e1859f9e5eb620504a4b1 Mon Sep 17 00:00:00 2001
From: Van de Bugger <van.de.bugger@gmail.com>
Date: Thu, 22 Oct 2015 23:06:30 +0300
Subject: [PATCH] PPI::Document constructor creates an object either from
 string or from file. However, even if object was created from a file, created
 object does not know name of the file it was created from. It makes error
 reporting difficult.

Code changed to let constructor save filename for latter use. BTW,
filename attribute introduced. It allows to specify filename even
if an object was created from a string. It may be useful if caller
code reads file and creates PPI document from a string.

See also: https://github.com/adamkennedy/PPI/issues/180
---
 lib/PPI/Document.pm      | 17 ++++++++++
 lib/PPI/Document/File.pm | 14 --------
 t/29_logical_filename.t  | 69 ++++++++++++++++++++++++++++++++++++++++
 t/data/filename.pl       | 10 ++++++
 4 files changed, 96 insertions(+), 14 deletions(-)
 create mode 100644 t/29_logical_filename.t
 create mode 100644 t/data/filename.pl

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<filename> accessor returns the name of the file in which the document
+is stored.
+
+=cut
+
+sub filename {
+	$_[0]->{filename};
+}
+
+=pod
+
 =head2 readonly
 
 The C<readonly> 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<filename> 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;