chase bug thrown up by merge_reading restriction; fix test that succeeded on a bad...

diff --git a/base/lib/Text/Tradition/Collation.pm b/base/lib/Text/Tradition/Collation.pm
index b4489f2..bbfc94f 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 );
+}
 }