From: tla <tla@mit.edu>
Date: Fri, 25 Oct 2013 13:54:57 +0000 (+0200)
Subject: finish and test Stemma::root_graph method. Fixes #9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1cf6dd3296c7bb84c4158cb1888098f830dbb3fa;p=scpubgit%2Fstemmatology.git

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
--- 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
--- 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();