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 (file)
--- 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 (file)
--- 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,