From: Stevan Little <stevan.little@iinteractive.com>
Date: Sun, 16 Sep 2007 19:47:14 +0000 (+0000)
Subject: more type system hacking and tests
X-Git-Tag: 0_26~13
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b17a3035c66fc43b00413edf83882b2ceebfcff1;p=gitmo%2FMoose.git

more type system hacking and tests
---

diff --git a/MANIFEST b/MANIFEST
index 633b98a..9cde2fc 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -96,6 +96,7 @@ t/040_type_constraints/008_union_types.t
 t/040_type_constraints/009_union_types_and_coercions.t
 t/040_type_constraints/010_misc_type_tests.t
 t/040_type_constraints/011_container_type_constraint.t
+t/040_type_constraints/012_container_type_coercion.t
 t/050_metaclasses/001_custom_attr_meta_with_roles.t
 t/050_metaclasses/002_custom_attr_meta_as_role.t
 t/050_metaclasses/003_moose_w_metaclass.t
diff --git a/lib/Moose/Meta/TypeConstraint/Container.pm b/lib/Moose/Meta/TypeConstraint/Container.pm
index d68859d..53c0324 100644
--- a/lib/Moose/Meta/TypeConstraint/Container.pm
+++ b/lib/Moose/Meta/TypeConstraint/Container.pm
@@ -20,8 +20,6 @@ __PACKAGE__->meta->add_attribute('container_type' => (
 sub compile_type_constraint {
     my $self = shift;
     
-    my $parent_name = $self->parent->name;
-    
     ($self->has_container_type)
         || confess "You cannot create a Container type without one";
         
@@ -32,6 +30,8 @@ sub compile_type_constraint {
     
     my $constraint;
     
+    my $parent_name = $self->parent->name;
+    
     if ($parent_name eq 'ArrayRef') {
         $constraint = sub {
             foreach my $x (@$_) { 
diff --git a/t/040_type_constraints/011_container_type_constraint.t b/t/040_type_constraints/011_container_type_constraint.t
index ea3be87..eb54e3b 100644
--- a/t/040_type_constraints/011_container_type_constraint.t
+++ b/t/040_type_constraints/011_container_type_constraint.t
@@ -3,11 +3,10 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 22;
 use Test::Exception;
 
-BEGIN {
-    use_ok('Moose');           
+BEGIN {    
     use_ok('Moose::Util::TypeConstraints');               
     use_ok('Moose::Meta::TypeConstraint::Container');               
 }
diff --git a/t/040_type_constraints/012_container_type_coercion.t b/t/040_type_constraints/012_container_type_coercion.t
new file mode 100644
index 0000000..a1324a7
--- /dev/null
+++ b/t/040_type_constraints/012_container_type_coercion.t
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Test::Exception;
+
+BEGIN {       
+    use_ok('Moose::Util::TypeConstraints');               
+    use_ok('Moose::Meta::TypeConstraint::Container');               
+}
+
+my $r = Moose::Util::TypeConstraints->_get_type_constraint_registry;
+
+# Array of Ints
+
+my $array_of_ints = Moose::Meta::TypeConstraint::Container->new(
+    name           => 'ArrayRef[Int]',
+    parent         => find_type_constraint('ArrayRef'),
+    container_type => find_type_constraint('Int'),
+);
+isa_ok($array_of_ints, 'Moose::Meta::TypeConstraint::Container');
+isa_ok($array_of_ints, 'Moose::Meta::TypeConstraint');
+
+$r->add_type_constraint($array_of_ints);
+
+is(find_type_constraint('ArrayRef[Int]'), $array_of_ints, '... found the type we just added');
+
+# Hash of Ints
+
+my $hash_of_ints = Moose::Meta::TypeConstraint::Container->new(
+    name           => 'HashRef[Int]',
+    parent         => find_type_constraint('HashRef'),
+    container_type => find_type_constraint('Int'),
+);
+isa_ok($hash_of_ints, 'Moose::Meta::TypeConstraint::Container');
+isa_ok($hash_of_ints, 'Moose::Meta::TypeConstraint');
+
+$r->add_type_constraint($hash_of_ints);
+
+is(find_type_constraint('HashRef[Int]'), $hash_of_ints, '... found the type we just added');
+
+## now attempt a coercion
+
+{
+    package Foo;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+    
+    coerce 'ArrayRef[Int]'
+        => from 'HashRef[Int]'
+            => via { [ values %$_ ] };
+    
+    has 'bar' => (
+        is     => 'ro',
+        isa    => 'ArrayRef[Int]',
+        coerce => 1,
+    );
+    
+}
+
+my $foo = Foo->new(bar => { one => 1, two => 2, three => 3 });
+isa_ok($foo, 'Foo');
+
+is_deeply([ sort @{$foo->bar} ], [ 1, 2, 3 ], '... our coercion worked!');
+
+