=begin testing
+use Set::Scalar;
use Test::More::UTF8;
use Text::Tradition;
use TryCatch;
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,
isa => 'ArrayRef[Set::Scalar]',
handles => {
groupings => 'elements',
- _add_grouping => 'push',
_set_grouping => 'set',
grouping => 'get',
},
# 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 ) }
} 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" );
}
}
# 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.
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