more cleanup/refactor and tests for the optional named constraints

diff --git a/lib/MooseX/Meta/TypeConstraint/Role/Structured.pm b/lib/MooseX/Meta/TypeConstraint/Role/Structured.pm
index 00e7722..d3beb38 100644 (file)
--- a/lib/MooseX/Meta/TypeConstraint/Role/Structured.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Role/Structured.pm
@@ -8,17 +8,9 @@ requires qw(_normalize_args signature_equals);
 
 MooseX::Meta::TypeConstraint::Role::Structured - Structured Type Constraints
 
-=head1 VERSION
-
-0.01
-
-=cut
-
-our $VERSION = '0.01';
-
 =head1 DESCRIPTION
 
-STUB - TBD
+This Role defines the interface and basic behavior of Structured Type Constraints.
 
 =head1 TYPES
 
@@ -66,15 +58,6 @@ has 'optional_signature' => (
 
 This class defines the following methods.
 
-=head2 _normalize_args
-
-Get arguments into a known state or die trying.  Ideally we try to make this
-into a HashRef so we can match it up with the L</signature> HashRef.
-    
-=head2 constraint
-
-The constraint is basically validating the L</signature> against the incoming
-
 =head2 equals
 
 modifier to make sure equals descends into the L</signature>
@@ -97,10 +80,6 @@ around 'equals' => sub {
     return 1;
 };
 
-=head2 signature_equals
-
-Check that the signature equals another signature.
-
 =head1 AUTHOR
 
 John James Napiorkowski <jjnapiork@cpan.org>

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured/Named.pm b/lib/MooseX/Meta/TypeConstraint/Structured/Named.pm
index 8c0b1d2..1bbfa83 100644 (file)
--- a/lib/MooseX/Meta/TypeConstraint/Structured/Named.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Structured/Named.pm
@@ -82,22 +82,20 @@ sub constraint {
     my $self = shift;
     return sub {
         my %args = $self->_normalize_args(shift);
-        my @signature = keys %{$self->signature};
-        my @ptional_signature = keys %{$self->optional_signature}
-         if $self->has_optional_signature;
         
         ## First make sure all the required type constraints match        
-        while( my $type_constraint_key = shift @signature) {
-            my $type_constraint = $self->signature->{$type_constraint_key};
-            if(my $error = $type_constraint->validate($args{$type_constraint_key})) {
+        foreach my $sig_key (keys %{$self->signature}) {
+            my $type_constraint = $self->signature->{$sig_key};
+            if(my $error = $type_constraint->validate($args{$sig_key})) {
                 confess $error;
+            } else {
+                delete $args{$sig_key};
             }
-            delete $args{$type_constraint_key};
         }
         
         ## Now test the option type constraints.
-        while( my $arg_key = keys %args) {
-            my $optional_type_constraint = $self->signature->{$arg_key};
+        foreach my $arg_key (keys %args) {
+            my $optional_type_constraint = $self->optional_signature->{$arg_key};
             if(my $error = $optional_type_constraint->validate($args{$arg_key})) {
                 confess $error;
             }              

diff --git a/t/constraints.t b/t/constraints.t
index 47287fc..aea5221 100644 (file)
--- a/t/constraints.t
+++ b/t/constraints.t
@@ -1,7 +1,7 @@
 BEGIN {
        use strict;
        use warnings;
-       use Test::More tests=>30;
+       use Test::More tests=>35;
        use Test::Exception;
 }
 
@@ -38,7 +38,7 @@ BEGIN {
     sub Dict {
         my ($args, $optional) = @_;
         my %args = @$args;
-        my %optional = ref $optional eq 'HASH' ? @$optional : ();
+        my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
         
         return MooseX::Meta::TypeConstraint::Structured::Named->new(
             name => 'Dict',
@@ -69,6 +69,7 @@ BEGIN {
        has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
        has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
     has 'optional_tuple' => (is=>'rw', isa=>Tuple(['Int', 'Int'],['Int']) );
+    has 'optional_dict' => (is=>'rw', isa=>Dict([key1=>'Int'],[key2=>'Int']) );   
 }
 
 ## Instantiate a new test object
@@ -205,3 +206,26 @@ throws_ok sub {
 }, qr/Validation failed for 'Int'/
  => 'Properly failed for bad value in optional bit';
 
+# Test optional_dict
+
+lives_ok sub {
+    $record->optional_dict({key1=>1,key2=>2});
+} => 'Set tuple attribute with optional bits';
+
+is_deeply $record->optional_dict, {key1=>1,key2=>2}
+ => 'correct values set';
+ 
+lives_ok sub {
+    $record->optional_dict({key1=>3});
+} => 'Set tuple attribute withOUT optional bits';
+
+is_deeply $record->optional_dict, {key1=>3}
+ => 'correct values set again';
+ 
+throws_ok sub {
+    $record->optional_dict({key1=>1,key2=>'bad'});   
+}, qr/Validation failed for 'Int'/
+ => 'Properly failed for bad value in optional bit';
+ 
+ 
+ 
\ No newline at end of file