fix: auto-invalidate location cache after document mutations

lib/PPI/Document.pm

@@ -647,6 +647,9 @@ from the file, these indexed locations will be B<wrong>.
 
 sub index_locations {
 	my $self   = shift;
+	if ( delete $self->{_locations_dirty} ) {
+		$self->flush_locations;
+	}
 	my @tokens = $self->tokens;
 
 	# Whenever we hit a heredoc we will need to increment by

lib/PPI/Element.pm

@@ -757,26 +757,15 @@ sub logical_filename {
 sub _ensure_location_present {
 	my $self = shift;
 
-	unless ( exists $self->{_location} ) {
-		# Are we inside a normal document?
-		my $Document = $self->document or return undef;
-		if ( $Document->isa('PPI::Document::Fragment') ) {
-			# Because they can't be serialized, document fragments
-			# do not support the concept of location.
-			return undef;
-		}
-
-		# Generate the locations. If they need one location, then
-		# the chances are they'll want more, and it's better that
-		# everything is already pre-generated.
-		$Document->index_locations or return undef;
-		unless ( exists $self->{_location} ) {
-			# erm... something went very wrong here
-			return undef;
-		}
+	my $Document = $self->document or return exists $self->{_location} ? 1 : undef;
+	if ( $Document->isa('PPI::Document::Fragment') ) {
+		return undef;
 	}
 
-	return 1;
+	return 1 if exists $self->{_location} and not $Document->{_locations_dirty};
+
+	$Document->index_locations or return undef;
+	return exists $self->{_location} ? 1 : undef;
 }
 
 # Although flush_locations is only publically a Document-level method,

lib/PPI/Node.pm

@@ -117,6 +117,7 @@ sub add_element {
 		$_PARENT{refaddr $Element} = $self
 	);
 
+	$self->__notify_locations_dirty;
 	1;
 }
 
@@ -516,6 +517,7 @@ sub remove_child {
 	splice( @{$self->{children}}, $p, 1 );
 	delete $_PARENT{$key};
 
+	$self->__notify_locations_dirty;
 	$child;
 }
 
@@ -732,6 +734,7 @@ sub __insert_before_child {
 			);
 	}
 	splice( @{$self->{children}}, $p, 0, @insertions );
+	$self->__notify_locations_dirty;
 	1;
 }
 
@@ -746,6 +749,7 @@ sub __insert_after_child {
 			);
 	}
 	splice( @{$self->{children}}, $p + 1, 0, @insertions );
+	$self->__notify_locations_dirty;
 	1;
 }
 
@@ -770,6 +774,8 @@ sub __replace_child {
 
 	# Uncache parent of old child
 	delete $_PARENT{$old_child_addr};
+
+	$self->__notify_locations_dirty;
 	1;
 }
 
@@ -802,6 +808,11 @@ sub __link_children {
 	1;
 }
 
+sub __notify_locations_dirty {
+	my $doc = $_[0]->document or return;
+	$doc->{_locations_dirty} = 1;
+}
+
 1;
 
 =pod

t/ppi_element_flush.t

@@ -70,10 +70,10 @@ EOSTM
 	$include2->replace($replacement);
 
 	my $nextsib = $replacement->next_sibling;
-	is_deeply $nextsib->location, [ 4, 91, 91, 4, $file ],
-	  'next token location is stale';
-	is_deeply $include3->location, [ 5, 1, 1, 5, $file ],
-	  'location of 3rd include stale';
+	is_deeply $nextsib->location, [ 9, 3, 3, 9, $file ],
+	  'next token location auto-refreshed after replace';
+	is_deeply $include3->location, [ 10, 1, 1, 10, $file ],
+	  'location of 3rd include auto-refreshed';
 
 	my $res = eval { $nextsib->_flush_locations };
 	is $@,   "", '_flush_locations lives';
@@ -114,13 +114,10 @@ EOSTM
 	$include2->replace($replacement);
 
 	my $nextsib = $replacement->next_sibling;
-	is_deeply $nextsib->location, [ 4, 91, 91, 4, $file ],
-	  'next token location is stale';
-
-	# now the $Document has a node without location, and all
-	# subsequent elements have a stale cached location.
+	is_deeply $nextsib->location, [ 9, 3, 3, 9, $file ],
+	  'next token location auto-refreshed after replace';
 
-	# a partial reindex should fix all location caches:
+	# explicit index_locations is now a no-op (already refreshed):
 	my $res = eval {
 		use warnings 'FATAL';
 		$Document->index_locations;

t/ppi_location_dirty.t

@@ -0,0 +1,125 @@
+#!/usr/bin/perl
+
+# Verify that location caches are automatically invalidated
+# after document mutations (insert, remove, replace, add, prune).
+
+use lib 't/lib';
+use PPI::Test::pragmas;
+
+use PPI::Document ();
+use PPI::Token::Whitespace ();
+use PPI::Token::Comment ();
+use PPI::Statement ();
+use Test::More tests => 6 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 );
+use Helper 'safe_new';
+
+subtest 'insert_before invalidates locations' => sub {
+	my $doc = safe_new \"my \$x = 1;\nmy \$y = 2;\n";
+
+	my @stmts = $doc->children;
+	my $y_stmt = $stmts[2];
+	is $y_stmt->first_token->content, 'my',
+		'found second my statement';
+	is_deeply $y_stmt->first_token->location, [ 2, 1, 1, 2, undef ],
+		'$y stmt starts at line 2 before insert';
+
+	my $new_doc = safe_new \"# inserted\n";
+	my $new_comment = $new_doc->find_first('PPI::Token::Comment')->remove;
+
+	$y_stmt->insert_before( $new_comment );
+
+	is_deeply $y_stmt->first_token->location, [ 3, 1, 1, 3, undef ],
+		'$y stmt location updated after insert_before';
+};
+
+subtest 'insert_after invalidates locations' => sub {
+	my $doc = safe_new \"my \$x = 1;\nmy \$y = 2;\n";
+
+	my @stmts = $doc->children;
+	my $x_stmt = $stmts[0];
+	my $y_stmt = $stmts[2];
+	is_deeply $y_stmt->first_token->location, [ 2, 1, 1, 2, undef ],
+		'$y stmt starts at line 2 before insert';
+
+	my $sep = $stmts[1];
+	my $new_ws = PPI::Token::Whitespace->new("\n");
+	my $new_doc = safe_new \"# inserted\n";
+	my $new_comment = $new_doc->find_first('PPI::Token::Comment')->remove;
+
+	$sep->insert_after( $new_comment );
+	$sep->insert_after( $new_ws );
+
+
+	is_deeply $y_stmt->first_token->location, [ 4, 1, 1, 4, undef ],
+		'$y stmt location updated after insert_after';
+};
+
+subtest 'remove invalidates locations' => sub {
+	my $doc = safe_new \"# first\nmy \$x = 1;\nmy \$y = 2;\n";
+
+	my $comment = $doc->find_first('PPI::Token::Comment');
+	my @stmts = grep { $_->isa('PPI::Statement') } $doc->children;
+	my $y_stmt = $stmts[1];
+	is_deeply $y_stmt->first_token->location, [ 3, 1, 1, 3, undef ],
+		'$y stmt starts at line 3 before remove';
+
+	$comment->remove;
+
+
+	is_deeply $y_stmt->first_token->location, [ 2, 1, 1, 2, undef ],
+		'$y stmt location updated after remove';
+};
+
+subtest 'replace invalidates locations' => sub {
+	my $doc = safe_new \"my \$x = 1 + 2;\n";
+
+	my $plus = $doc->find_first(
+		sub { $_[1]->isa('PPI::Token::Operator') and $_[1]->content eq '+' }
+	);
+	is $plus->content, '+', 'found plus operator';
+	is_deeply $plus->location, [ 1, 11, 11, 1, undef ],
+		'plus at column 11 before replace';
+
+	my $one = ($doc->find('PPI::Token::Number'))->[0];
+	my $replacement = PPI::Token::Number->new('100');
+	$one->replace( $replacement );
+
+
+	is_deeply $plus->location, [ 1, 13, 13, 1, undef ],
+		'plus column updated after replacing 1 with 100';
+};
+
+subtest 'add_element invalidates locations' => sub {
+	my $doc = safe_new \"sub foo { 1 }\nmy \$y = 2;\n";
+
+	my @stmts = grep { $_->isa('PPI::Statement') } $doc->children;
+	my $y_stmt = $stmts[1];
+	is_deeply $y_stmt->first_token->location, [ 2, 1, 1, 2, undef ],
+		'$y stmt starts at line 2 before add';
+
+	my $block = $doc->find_first('PPI::Structure::Block');
+	$block->add_element( PPI::Token::Whitespace->new("\n") );
+	my $new_stmt = PPI::Statement->new;
+	$new_stmt->add_element( PPI::Token::Word->new('bar') );
+	$block->add_element( $new_stmt );
+	$block->add_element( PPI::Token::Whitespace->new("\n") );
+
+
+	is_deeply $y_stmt->first_token->location, [ 4, 1, 1, 4, undef ],
+		'$y stmt pushed down after adding lines to block';
+};
+
+subtest 'prune invalidates locations' => sub {
+	my $doc = safe_new \"# first\nmy \$x = 1;\nmy \$y = 2;\n";
+
+	my @stmts = grep { $_->isa('PPI::Statement') } $doc->children;
+	my $y_stmt = $stmts[1];
+	is_deeply $y_stmt->first_token->location, [ 3, 1, 1, 3, undef ],
+		'$y stmt starts at line 3 before prune';
+
+	$doc->prune('PPI::Token::Comment');
+
+
+	is_deeply $y_stmt->first_token->location, [ 2, 1, 1, 2, undef ],
+		'$y stmt location updated after prune removes comment';
+};