moved around the subroutines that generate constraints
[gitmo/MooseX-Types-Structured.git] / t / constraints.t
index 1e4c36f..a385763 100644 (file)
@@ -1,7 +1,7 @@
 BEGIN {
        use strict;
        use warnings;
-       use Test::More tests=>23;
+       use Test::More tests=>42;
        use Test::Exception;
 }
 
@@ -9,42 +9,46 @@ BEGIN {
     package Test::MooseX::Meta::TypeConstraint::Structured;
 
     use Moose;
-    use Moose::Util::TypeConstraints;
-    use MooseX::Meta::TypeConstraint::Structured;
-    
+    use MooseX::Types::Structured qw(Tuple Dict);
+       use Moose::Util::TypeConstraints;
+
     subtype 'MyString',
      as 'Str',
      where { $_=~m/abc/};
-      
-    sub Tuple {
-        my @args = @{shift @_};
-        return MooseX::Meta::TypeConstraint::Structured->new(
-            name => 'Tuple',
-            parent => find_type_constraint('ArrayRef'),
-            package_defined_in => __PACKAGE__,
-            signature => [map {
-                               Moose::Util::TypeConstraints::find_or_parse_type_constraint ($_)
-                       } @args],
-        );
-    }
-       
-    sub Dict {
-        my %args = @{shift @_};
-        return MooseX::Meta::TypeConstraint::Structured->new(
-            name => 'Dict',
-            parent => find_type_constraint('HashRef'),
-            package_defined_in => __PACKAGE__,
-            signature => {map {
-                               $_ => Moose::Util::TypeConstraints::find_or_parse_type_constraint($args{$_})
-                       } keys %args},
-        );
-    }
 
     has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
     has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
     has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']);    
        has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
        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'] );
+    
+    has 'crazy' => (
+        is=>'rw',
+        isa=>Tuple(
+            ## First ArrayRef Arg is the required type constraints for the top
+            ## level Tuple.
+            [
+                'Int',
+                'MyString',
+                ## The third required element is a Dict type constraint, which
+                ## itself has two required keys and a third optional key.
+                Dict([name=>'Str',age=>'Int'],[visits=>'Int'])
+            ],
+            ## Second ArrayRef Arg defines the optional constraints for the top
+            ## level Tuple.
+            [
+                'Int',
+                ## This Tuple has one required type constraint and two optional.
+                Tuple(
+                      ['Int'],
+                      ['Int','HashRef'],
+                ),
+            ],        
+        )
+    );
 }
 
 ## Instantiate a new test object
@@ -54,7 +58,37 @@ ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
  
 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
  => 'Created correct object type.';
-  
+## Test crazy
+
+lives_ok sub {
+    $record->crazy([1,'hello.abc.world', {name=>'John', age=>39}]);
+} => 'Set crazy attribute with no optionals used';
+
+is_deeply $record->crazy, [1, 'hello.abc.world', {name=>'John', age=>39}]
+ => 'correct values for crazy attributes no optionals';
+lives_ok sub {
+    $record->crazy([1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]);
+} => 'Set crazy attribute with all optionals used';
+
+is_deeply $record->crazy, [1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]
+ => 'correct values for crazy attributes all optionals';
+
+lives_ok sub {
+    $record->crazy([1,'hello.abc.world', {name=>'John', age=>39},10, [1,2]]);
+} => 'Set crazy attribute with some optionals used';
+
+throws_ok sub {
+    $record->crazy([1,'hello', 'test.xxx.test']);    
+}, qr/Validation failed for 'MyString'/
+ => 'Properly failed for bad value in crazy attribute 01';
+
+throws_ok sub {
+    $record->crazy([1,'hello.abc.world', {notname=>'John', notage=>39}]);    
+}, qr/Validation failed for 'Str'/
+ => 'Properly failed for bad value in crazy attribute 02';
 ## Test Tuple type constraint
 
 lives_ok sub {
@@ -148,4 +182,57 @@ throws_ok sub {
 lives_ok sub {
     $record->dict_with_maybe({name=>'usal'});
 } => 'Set dict attribute without error, skipping optional';
+
+## Test dict_with_tuple
+
+lives_ok sub {
+    $record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
+} => 'Set tuple attribute without error';
+
+throws_ok sub {
+    $record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
+}, qr/Validation failed for 'Int'/
+ => 'Threw error on bad constraint';
+
+## Test optional_tuple
+
+lives_ok sub {
+    $record->optional_tuple([1,2,3]);
+} => 'Set tuple attribute with optional bits';
+
+is_deeply $record->optional_tuple, [1,2,3]
+ => 'correct values set';
+lives_ok sub {
+    $record->optional_tuple([4,5]);
+} => 'Set tuple attribute withOUT optional bits';
+
+is_deeply $record->optional_tuple, [4,5]
+ => 'correct values set again';
+throws_ok sub {
+    $record->optional_tuple([1,2,'bad']);   
+}, 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