From: Tara L Andrews <tla@mit.edu>
Date: Mon, 27 Aug 2012 14:24:45 +0000 (+0200)
Subject: make sure groupinglist always == setlist in size
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=85a74a8dcaa8c374d1bf2eb5114142455cfd72bf;p=scpubgit%2Fstemmatology.git

make sure groupinglist always == setlist in size
---

diff --git a/lib/Text/Tradition/Analysis/Result.pm b/lib/Text/Tradition/Analysis/Result.pm
index 531ae97..d311ad2 100644
--- a/lib/Text/Tradition/Analysis/Result.pm
+++ b/lib/Text/Tradition/Analysis/Result.pm
@@ -76,6 +76,7 @@ follows that of a parent on the graph.
 
 =begin testing
 
+use Set::Scalar;
 use Test::More::UTF8;
 use Text::Tradition;
 use TryCatch;
@@ -116,6 +117,14 @@ try {
 	like( $e->message, qr/Failed to find witness set that is a subset of/, 
 		"Correct error thrown on bad record_grouping attempt" );
 }
+# Test manually setting an out-of-range group
+try {
+	$result->_set_grouping( 3, Set::Scalar->new( qw/ X Y / ) );
+	ok( 0, "Set a grouping at an invalid index" );
+} catch ( Text::Tradition::Error $e ) {
+	is( $e->message, 'Set / group index 3 out of range for set_grouping', 
+		"Caught attempt to set grouping at invalid index" );
+}
 $result->record_grouping( [ qw/ 3 F H / ] );
 my $gp1 = $result->grouping(1);
 is( $result->minimum_grouping_for( $rsets[1] ), $gp1, 
@@ -192,7 +201,6 @@ has 'groupinglist' => (
 	isa => 'ArrayRef[Set::Scalar]',
 	handles => {
 		groupings => 'elements',
-		_add_grouping => 'push',
 		_set_grouping => 'set',
 		grouping => 'get',
 	},
@@ -278,9 +286,23 @@ sub BUILD {
 	my $self = shift;
 	
 	# Initialize the groupings array
-	map { $self->_add_grouping( $_ ) } $self->sets;
+	my @sets = $self->sets;
+	foreach my $idx( 0 .. $#sets ) {
+		unless( $self->grouping( $idx ) ) {
+			$self->_set_grouping( $idx, $sets[$idx] );
+		}
+	}
 }
 
+before '_set_grouping' => sub {
+	my $self = shift;
+	my $idx = $_[0];
+	my $max = scalar $self->sets;
+	if( $idx >= $max ) {
+		throw( "Set / group index $idx out of range for set_grouping" );
+	}
+};
+
 =head2 $self->object_key
 
 Returns a unique key that can be used to look up this graph/set combination in
diff --git a/t/text_tradition_analysis_result.t b/t/text_tradition_analysis_result.t
index 9d68aa2..e3462dc 100644
--- a/t/text_tradition_analysis_result.t
+++ b/t/text_tradition_analysis_result.t
@@ -8,6 +8,7 @@ $| = 1;
 
 # =begin testing
 {
+use Set::Scalar;
 use Test::More::UTF8;
 use Text::Tradition;
 use TryCatch;
@@ -48,6 +49,14 @@ try {
 	like( $e->message, qr/Failed to find witness set that is a subset of/, 
 		"Correct error thrown on bad record_grouping attempt" );
 }
+# Test manually setting an out-of-range group
+try {
+	$result->_set_grouping( 3, Set::Scalar->new( qw/ X Y / ) );
+	ok( 0, "Set a grouping at an invalid index" );
+} catch ( Text::Tradition::Error $e ) {
+	is( $e->message, 'Set / group index 3 out of range for set_grouping', 
+		"Caught attempt to set grouping at invalid index" );
+}
 $result->record_grouping( [ qw/ 3 F H / ] );
 my $gp1 = $result->grouping(1);
 is( $result->minimum_grouping_for( $rsets[1] ), $gp1,