X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=base%2Flib%2FText%2FTradition%2FCollation.pm;h=58c4ec383acc1c8c35c1b7d47ee4c60f6c89bbcb;hb=2dcb5d113759db79ed1b76b74472c7748d51a898;hp=be84609c2c4636661bd0ee067902db4b1b16d0bb;hpb=db80d3ec75a5a6af122e4319b80fe7e0624db4f7;p=scpubgit%2Fstemmatology.git

diff --git a/base/lib/Text/Tradition/Collation.pm b/base/lib/Text/Tradition/Collation.pm
index be84609..58c4ec3 100644
--- a/base/lib/Text/Tradition/Collation.pm
+++ b/base/lib/Text/Tradition/Collation.pm
@@ -476,7 +476,7 @@ is( scalar( $sc->readings ), $numr, "There are $numr readings in the graph" );
 is( $sc->end->rank, 14, "There are fourteen ranks in the graph" );
 
 # Detach the erroneously collated reading
-my $newr = $sc->duplicate_reading( 'n131', 'Ba96' );
+my( $newr, @del_rdgs ) = $sc->duplicate_reading( 'n131', 'Ba96' );
 ok( $newr, "New reading was created" );
 ok( $sc->reading('n131_0'), "Detached the bad collation with a new reading" );
 is( scalar( $sc->readings ), $numr + 1, "A reading was added to the graph" );
@@ -485,6 +485,7 @@ my $csucc = $sc->common_successor( 'n131', 'n131_0' );
 is( $csucc->id, 'n136', "Found correct common successor to duped reading" ); 
 
 # Check that the bad transposition is gone
+is( scalar @del_rdgs, 1, "Deleted reading was returned by API call" );
 is( $sc->get_relationship( 'n130', 'n135' ), undef, "Bad transposition relationship is gone" );
 
 # The collation should not be fixed
@@ -556,6 +557,7 @@ sub duplicate_reading {
 	# remove them. If not, we can skip it.
 	my $succ;
 	my %rrk;
+	my @deleted_relations;
 	if( $self->end->has_rank ) {
 		# Find the point where we can stop checking
 		$succ = $self->common_successor( $r, $newr );
@@ -576,11 +578,13 @@ sub duplicate_reading {
 			my @noncolo = $rdg->related_readings( sub { !$_[0]->colocated } );
 			next unless @noncolo;
 			foreach my $nc ( @noncolo ) {
-				$self->relations->verify_or_delete( $rdg, $nc );
+				unless( $self->relations->verify_or_delete( $rdg, $nc ) ) {
+					push( @deleted_relations, $nc );
+				}
 			}
 		}
 	}
-	return $newr;
+	return ( $newr, @deleted_relations );
 }
 
 sub _generate_dup_id {