finish and test Stemma::root_graph method. Fixes #9

diff --git a/analysis/lib/Text/Tradition/Stemma.pm b/analysis/lib/Text/Tradition/Stemma.pm
index a309804..9bd6f01 100644 (file)
--- a/analysis/lib/Text/Tradition/Stemma.pm
+++ b/analysis/lib/Text/Tradition/Stemma.pm
@@ -520,6 +520,12 @@ sub root_graph {
                # Make an undirected version of this graph.
                $graph = $self->graph->undirected_copy();
        }
+       # First, ensure that the requested root is actually a vertex in the graph.
+       unless( $graph->has_vertex( $rootvertex ) ) {
+               throw( "Cannot orient graph $graph on nonexistent vertex $rootvertex" );
+       }
+       
+       # Now make a directed version of the graph.
        my $rooted = Graph->new();
        $rooted->add_vertex( $rootvertex );
        my @next = ( $rootvertex );
@@ -539,10 +545,10 @@ sub root_graph {
        }
        # Set the vertex classes
        map { $rooted->set_vertex_attribute( $_, 'class', 'hypothetical' ) }
-               $self->graph->hypotheticals;
-       map { $rooted->set_vertex_class( $_, 'class', 'extant' ) }
-               $self->graph->witnesses;
-       return $rooted;
+               $self->hypotheticals;
+       map { $rooted->set_vertex_attribute( $_, 'class', 'extant' ) }
+               $self->witnesses;
+       $self->graph( $rooted );
 }
 
 

diff --git a/analysis/t/stemma.t b/analysis/t/stemma.t
index 6b361cf..731045d 100644 (file)
--- a/analysis/t/stemma.t
+++ b/analysis/t/stemma.t
@@ -70,4 +70,17 @@ ok( $display !~ /hypothetical/, "Graph is display rather than edit" );
 my $editable = $stemma->editable();
 ok( $editable =~ /digraph/, "Got a dot edit graph" );
 ok( $editable =~ /hypothetical/, "Graph contains an edit class" );
+
+# Test re-rooting of our graph
+try {
+       $stemma->root_graph('D');
+       ok( 0, "Made attempt to root stemma graph on nonexistent vertex" );
+} catch( Text::Tradition::Error $e ) {
+       like( $e->message, qr/Cannot orient graph(.*)on nonexistent vertex/,
+               "Exception raised for attempt to root graph on nonexistent vertex" );
+}
+$stemma->root_graph( 'B' );
+is( $stemma->graph, '1-A,2-1,2-C,B-2', 
+       "Stemma graph successfully re-rooted on vertex B" );
+
 done_testing();