test/fix for bug in metaless equivalence graph

[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation / RelationshipStore.pm

diff --git a/lib/Text/Tradition/Collation/RelationshipStore.pm b/lib/Text/Tradition/Collation/RelationshipStore.pm
index 253486d..d0c4c00 100644 (file)
--- a/lib/Text/Tradition/Collation/RelationshipStore.pm
+++ b/lib/Text/Tradition/Collation/RelationshipStore.pm
@@ -311,6 +311,16 @@ try {
                "Relationship link prevented for a meta reading" );
 }
 
+# Test 1.4: try to break a relationship near a meta reading
+$c1->add_relationship( 'r7.6', 'r7.3', { type => 'orthographic' } );
+try {
+       $c1->del_relationship( 'r7.6', 'r7.7' );
+       $c1->del_relationship( 'r7.6', 'r7.3' );
+       ok( 1, "Relationship broken with a meta reading as neighbor" );
+} catch {
+       ok( 0, "Relationship deletion failed with a meta reading as neighbor" );
+}
+
 # Test 2.1: try to equate nodes that are prevented with a real intermediate
 # equivalence
 my $t2;
@@ -951,9 +961,11 @@ sub _break_equivalence {
        my $c = $self->collation;
        foreach my $rdg ( @$newmembers ) {
                foreach my $rp ( $c->sequence->predecessors( $rdg ) ) {
+                       next unless $self->equivalence( $rp );
                        $self->equivalence_graph->add_edge( $self->equivalence( $rp ), $newgroup );
                }
                foreach my $rs ( $c->sequence->successors( $rdg ) ) {
+                       next unless $self->equivalence( $rs );
                        $self->equivalence_graph->add_edge( $newgroup, $self->equivalence( $rs ) );
                }
        }
@@ -962,9 +974,11 @@ sub _break_equivalence {
        my( %old_pred, %old_succ );
        foreach my $rdg ( @$oldmembers ) {
                foreach my $rp ( $c->sequence->predecessors( $rdg ) ) {
+                       next unless $self->equivalence( $rp );
                        $old_pred{$self->equivalence( $rp )} = 1;
                }
                foreach my $rs ( $c->sequence->successors( $rdg ) ) {
+                       next unless $self->equivalence( $rs );
                        $old_succ{$self->equivalence( $rs )} = 1;
                }
        }