cosmetic fixes to error messages

[scpubgit/stemmatology.git] / lib / Text / Tradition / Analysis / Result.pm

diff --git a/lib/Text/Tradition/Analysis/Result.pm b/lib/Text/Tradition/Analysis/Result.pm
index 531ae97..91c8a49 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',
        },
@@ -218,9 +226,9 @@ around BUILDARGS => sub {
        
        # Convert the set list into a list of Set::Scalars, ordered first by size and
        # then alphabetically by first-sorted.
-       die "Must specify a set list to Analysis::Result->new()" 
+       throw( "Must specify a set list to Analysis::Result->new()" )
                unless ref( $args->{'setlist'} ) eq 'ARRAY'; 
-       die "Empty set list specified to Analysis::Result->new()"
+       throw( "Empty set list specified to Analysis::Result->new()" )
                unless @{$args->{'setlist'}};
        # Order the sets and make sure they are all distinct Set::Scalars.
        $args->{'setlist'} = [ sort { by_size_and_alpha( $a, $b ) } 
@@ -240,7 +248,7 @@ around BUILDARGS => sub {
                } elsif( $type eq 'Graph' ) {
                        $args->{'graph'} = Text::Tradition::Stemma::editable_graph( $st, $gopt );
                } else {
-                       die "Passed argument to graph that is neither Stemma nor Graph";
+                       throw( "Passed argument to graph that is neither Stemma nor Graph" );
                }
        } 
        
@@ -260,12 +268,12 @@ sub _check_set_args {
                # Check uniqueness of the current set
                if( ref( $set ) ne 'Set::Scalar' ) {
                        $s = Set::Scalar->new( @$set );
-                       die "Duplicate element(s) in set or group passed to Analysis::Result->new()"
+                       throw( "Duplicate element(s) in set or group passed to Analysis::Result->new()" )
                                unless @$set == $s->elements;
                }
                # Check distinctness of the set from all other sets given so far
                foreach my $ps ( @sets ) {
-                       die "Two sets are not disjoint"
+                       throw( "Two sets $s / $ps are not disjoint" )
                                unless $s->is_disjoint( $ps );
                }
                # Save the set.
@@ -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