X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F07-coerce.t;h=7433acdff029eb6be4cb342ce4658841d58af2fc;hb=ae99852990e7c7faf5d4f44fc58f144d1b5dd2fd;hp=a918c07f1582d092658bf84ab4ec713a85fce828;hpb=c81443cb26d69dfd732202a51b2ad68549a829c2;p=gitmo%2FMooseX-Types-Structured.git

diff --git a/t/07-coerce.t b/t/07-coerce.t
index a918c07..7433acd 100644
--- a/t/07-coerce.t
+++ b/t/07-coerce.t
@@ -1,7 +1,7 @@
 BEGIN {
 	use strict;
 	use warnings;
-	use Test::More tests=>1;
+	use Test::More tests=>16;
 	use Test::Exception;
 }
 
@@ -12,12 +12,88 @@ BEGIN {
     use MooseX::Types::Structured qw(Dict Tuple);
 	use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef);
 	use MooseX::Types -declare => [qw(
+        myDict myTuple Fullname
 
     )];
     
+    subtype myDict,
+     as Dict[name=>Str, age=>Int];
+     
+    subtype Fullname,
+     as Dict[first=>Str, last=>Str];
+     
+    coerce Fullname,
+     from ArrayRef,
+     via { +{first=>$_->[0], last=>$_->[1]} };
+     
+    subtype myTuple,
+     as Tuple[Str, Int];
 
+    ## Create some coercions.  Note the dob_epoch could be a more useful convert
+    ## from a dob datetime object, I'm just lazy.
+    
+    coerce myDict,
+     from Int,
+     via { +{name=>'JohnDoe', age=>$_} },
+     from Dict[aname=>HashRef, dob_in_years=>Int],
+     via { +{
+        name=> $_->{aname}->{first} .' '. $_->{aname}->{last},
+        age=>$_->{dob_in_years},
+        }
+     },
+     from Dict[bname=>HashRef, dob_in_years=>Int],
+     via { +{
+        name=> $_->{bname}->{first} .' '. $_->{bname}->{last},
+        age=>$_->{dob_in_years},
+        }
+     },
+     from Dict[fullname=>Fullname, dob_epoch=>Int],
+     via { +{
+        name=> $_->{fullname}->{first} .' '. $_->{fullname}->{last},
+        age=>$_->{dob_epoch}}
+     },
+     from myTuple,
+     via { +{name=>$_->[0], age=>$_->[1]} };
+
+    has 'stuff' => (is=>'rw', isa=>myDict, coerce=>1);
 }
 
+## Create an object to test
+
+ok my $person = Test::MooseX::Meta::TypeConstraint::Structured::Coerce->new();
+isa_ok $person, 'Test::MooseX::Meta::TypeConstraint::Structured::Coerce';## Try out the coercions
+
+ok $person->stuff({name=>"John",age=>25}), 'Set Stuff {name=>"John",age=>25}';
+is_deeply $person->stuff, {name=>"John",age=>25}, 'Correct set';
+
+ok $person->stuff(30), 'Set Stuff 30';
+is_deeply $person->stuff, {name=>"JohnDoe",age=>30}, 'Correct set';
+
+ok $person->stuff({aname=>{first=>"frank", last=>"herbert"},dob_in_years=>80}),
+ '{{first=>"frank", last=>"herbert"},80}';
+ 
+is_deeply $person->stuff, {name=>"frank herbert",age=>80}, 'Correct set';
 
+ok $person->stuff({bname=>{first=>"frankbbb", last=>"herbert"},dob_in_years=>84}),
+ '{{first=>"frankbbb", last=>"herbert"},84}';
+ 
+is_deeply $person->stuff, {name=>"frankbbb herbert",age=>84}, 'Correct set';
+
+ok $person->stuff(["mary",40]), 'Set Stuff ["mary",40]';
+is_deeply $person->stuff, {name=>"mary",age=>40}, 'Correct set';
+
+ok $person->stuff({fullname=>{first=>"frank", last=>"herbert1"},dob_epoch=>85}),
+ '{{first=>"frank", last=>"herbert1"},85}';
+ 
+is_deeply $person->stuff, {name=>"frank herbert1",age=>85}, 'Correct set';
+
+SKIP: {
+    skip 'deep coercions not yet supported', 2, 1;
+    
+    ok $person->stuff({fullname=>["frank", "herbert2"],dob_epoch=>86}),
+     '{fullname=>["frank", "herbert2"],dob_epoch=>86}';
+ 
+    is_deeply $person->stuff, {name=>"frank herbert2",age=>86}, 'Correct set';   
+}