From: Tara L Andrews <tla@mit.edu>
Date: Tue, 21 Jan 2014 20:35:43 +0000 (+0100)
Subject: chase bug thrown up by merge_reading restriction; fix test that succeeded on a bad... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=58568d5cb2eeee016f3974dc09017f81f112f2fb;p=scpubgit%2Fstemmatology.git

chase bug thrown up by merge_reading restriction; fix test that succeeded on a bad merge. (I hope) fixes #20.
---

diff --git a/base/lib/Text/Tradition/Collation.pm b/base/lib/Text/Tradition/Collation.pm
index b4489f2..bbfc94f 100644
--- a/base/lib/Text/Tradition/Collation.pm
+++ b/base/lib/Text/Tradition/Collation.pm
@@ -299,6 +299,7 @@ The first two arguments may be either readings or reading IDs.
 =begin testing
 
 use Text::Tradition;
+use TryCatch;
 
 my $cxfile = 't/data/Collatex-16.xml';
 my $t = Text::Tradition->new( 
@@ -331,12 +332,24 @@ $c->merge_readings( 'n9', 'n10' );
 ok( !$c->reading('n10'), "Reading n10 is gone" );
 is( $c->reading('n9')->text, 'rood', "Reading n9 has an unchanged word" );
 
-# Combine n21 and n21p0
+# Try to combine n21 and n21p0. This should break.
 my $remaining = $c->reading('n21');
 $remaining ||= $c->reading('n22');  # one of these should still exist
-$c->merge_readings( 'n21p0', $remaining, 1 );
-ok( !$c->reading('n21'), "Reading $remaining is gone" );
-is( $c->reading('n21p0')->text, 'unto', "Reading n21p0 merged correctly" );
+try {
+	$c->merge_readings( 'n21p0', $remaining, 1 );
+	ok( 0, "Bad reading merge changed the graph" );
+} catch( Text::Tradition::Error $e ) {
+	like( $e->message, qr/neither concatenated nor collated/, "Expected exception from bad concatenation" );
+} catch {
+	ok( 0, "Unexpected error on bad reading merge: $@" );
+}
+
+try {
+	$c->calculate_ranks();
+	ok( 1, "Graph is still evidently whole" );
+} catch( Text::Tradition::Error $e ) {
+	ok( 0, "Caught a rank exception: " . $e->message );
+}
 
 =end testing
 
@@ -417,14 +430,16 @@ WARNING: This operation cannot be undone.
 
 =begin testing
 
+use Test::Warn;
 use Text::Tradition;
 use TryCatch;
 
-my $t = Text::Tradition->new( 
-    'name'  => 'inline', 
-    'input' => 'Self',
-    'file'  => 't/data/legendfrag.xml',
-    );
+my $t;
+warnings_exist {
+	$t = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/legendfrag.xml' );
+} [qr/Cannot set relationship on a meta reading/],
+	"Got expected relationship drop warning on parse";
+
 my $c = $t->collation;
 
 my %rdg_ids;
@@ -461,8 +476,6 @@ try {
 		"Rank calculation on merged graph threw an error" );
 }
 
-
-
 =end testing
 
 =cut
@@ -479,7 +492,6 @@ sub merge_related {
 		exists $reltypehash{$_[0]->type};
 	};
 	
-	my $linear = 1;
 	# Go through all readings looking for related ones
 	foreach my $r ( $self->readings ) {
 		next unless $self->reading( "$r" ); # might have been deleted meanwhile
@@ -491,13 +503,12 @@ sub merge_related {
 				} @related;
 			my $keep = shift @related;
 			foreach my $delr ( @related ) {
-				$linear = undef 
+				$self->linear( 0 )
 					unless( $self->get_relationship( $keep, $delr )->colocated );
 				$self->merge_readings( $keep, $delr );
 			}
 		}
 	}
-	$self->linear( $linear );
 }
 
 =head2 compress_readings
@@ -637,6 +648,13 @@ try {
 	ok( 0, "Reading duplication with all witnesses threw the wrong error" );
 }
 
+try {
+	$sc->calculate_ranks();
+	ok( 1, "Graph is still evidently whole" );
+} catch( Text::Tradition::Error $e ) {
+	ok( 0, "Caught a rank exception: " . $e->message );
+}
+
 =end testing
 
 =cut
diff --git a/base/lib/Text/Tradition/Collation/RelationshipStore.pm b/base/lib/Text/Tradition/Collation/RelationshipStore.pm
index 05dfea8..f7cf1b9 100644
--- a/base/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/base/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -1277,13 +1277,14 @@ sub _make_equivalence {
 	map { $self->set_equivalence( $_, $teq ) } @$sourcepool;
 	# Then merge the nodes in the equivalence graph.
 	foreach my $pred ( $self->equivalence_graph->predecessors( $seq ) ) {
+		next if $pred eq $teq; # don't add a self-loop on concatenation merge
 		$self->equivalence_graph->add_edge( $pred, $teq );
 	}
 	foreach my $succ ( $self->equivalence_graph->successors( $seq ) ) {
+		next if $succ eq $teq; # don't add a self-loop on concatenation merge
 		$self->equivalence_graph->add_edge( $teq, $succ );
 	}
 	$self->equivalence_graph->delete_vertex( $seq );
-	# TODO enable this after collation parsing is done
 	throw( "Graph got disconnected making $source / $target equivalence" )
 		if $self->_is_disconnected && $self->collation->tradition->_initialized;
 }
diff --git a/base/t/text_tradition_collation.t b/base/t/text_tradition_collation.t
index 69c4498..e8e4b8e 100644
--- a/base/t/text_tradition_collation.t
+++ b/base/t/text_tradition_collation.t
@@ -9,6 +9,7 @@ $| = 1;
 # =begin testing
 {
 use Text::Tradition;
+use TryCatch;
 
 my $cxfile = 't/data/Collatex-16.xml';
 my $t = Text::Tradition->new( 
@@ -41,26 +42,40 @@ $c->merge_readings( 'n9', 'n10' );
 ok( !$c->reading('n10'), "Reading n10 is gone" );
 is( $c->reading('n9')->text, 'rood', "Reading n9 has an unchanged word" );
 
-# Combine n21 and n21p0
+# Try to combine n21 and n21p0. This should break.
 my $remaining = $c->reading('n21');
 $remaining ||= $c->reading('n22');  # one of these should still exist
-$c->merge_readings( 'n21p0', $remaining, 1 );
-ok( !$c->reading('n21'), "Reading $remaining is gone" );
-is( $c->reading('n21p0')->text, 'unto', "Reading n21p0 merged correctly" );
+try {
+	$c->merge_readings( 'n21p0', $remaining, 1 );
+	ok( 0, "Bad reading merge changed the graph" );
+} catch( Text::Tradition::Error $e ) {
+	like( $e->message, qr/neither concatenated nor collated/, "Expected exception from bad concatenation" );
+} catch {
+	ok( 0, "Unexpected error on bad reading merge: $@" );
+}
+
+try {
+	$c->calculate_ranks();
+	ok( 1, "Graph is still evidently whole" );
+} catch( Text::Tradition::Error $e ) {
+	ok( 0, "Caught a rank exception: " . $e->message );
+}
 }
 
 
 
 # =begin testing
 {
+use Test::Warn;
 use Text::Tradition;
 use TryCatch;
 
-my $t = Text::Tradition->new( 
-    'name'  => 'inline', 
-    'input' => 'Self',
-    'file'  => 't/data/legendfrag.xml',
-    );
+my $t;
+warnings_exist {
+	$t = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/legendfrag.xml' );
+} [qr/Cannot set relationship on a meta reading/],
+	"Got expected relationship drop warning on parse";
+
 my $c = $t->collation;
 
 my %rdg_ids;
@@ -160,6 +175,13 @@ try {
 } catch {
 	ok( 0, "Reading duplication with all witnesses threw the wrong error" );
 }
+
+try {
+	$sc->calculate_ranks();
+	ok( 1, "Graph is still evidently whole" );
+} catch( Text::Tradition::Error $e ) {
+	ok( 0, "Caught a rank exception: " . $e->message );
+}
 }