finished parameterized method, tests and converted Moose::Util::TypeConstraints to...

diff --git a/lib/Moose/Meta/TypeConstraint/Parameterizable.pm b/lib/Moose/Meta/TypeConstraint/Parameterizable.pm
index 530f026..a8e32a3 100644 (file)
--- a/lib/Moose/Meta/TypeConstraint/Parameterizable.pm
+++ b/lib/Moose/Meta/TypeConstraint/Parameterizable.pm
@@ -42,20 +42,25 @@ sub _can_coerce_constraint_from {
 }
 
 sub parameterize {
-       my ($self, $args) = @_;
+       my ($self, @args) = @_;
+    
+    ## ugly hacking to deal with tc naming normalization issue
+    my ($tc_name, $contained_tc);
+    if (ref $args[0]) {
+        $contained_tc = shift @args;
+        $tc_name = $self->name .'['. $contained_tc->name .']';
+    } else {
+        ($tc_name, $contained_tc) = @args;
+    }
        
-       unless(ref $args eq 'ARRAY') {
-                 Moose->throw_error(
-                       "The type constraint ".$self->name." requires it's argument to be an ArrayRef"
-               );
+       unless($contained_tc->isa('Moose::Meta::TypeConstraint')) {
+               Moose->throw_error("The type parameter must be a Moose meta type");
        }
        
-       my $contained_tc = find_or_create_isa_type_constraint($args->[0]);
-       
     return Moose::Meta::TypeConstraint::Parameterized->new(
-        name           => $self->name .'['.$contained_tc->name.']',
+        name           => $tc_name,
         parent         => $self,
-        type_parameter => find_or_create_isa_type_constraint($contained_tc),
+        type_parameter => $contained_tc,
     ); 
 }
 
@@ -81,6 +86,10 @@ Moose::Meta::TypeConstraint::Parameterizable - Higher Order type constraints for
 
 =item B<generate_constraint_for>
 
+=item B<parameterize>
+
+Given an array of type constraints, parameterize the current type constraint.
+
 =item B<meta>
 
 =back

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 582c1c9..ac6802c 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -121,19 +121,35 @@ sub create_type_constraint_union (@) {
 sub create_parameterized_type_constraint ($) {
     my $type_constraint_name = shift;
 
-    my ($base_type, $type_parameter) = _parse_parameterized_type_constraint($type_constraint_name);
+    my ($base_type, $type_parameter_str) = _parse_parameterized_type_constraint($type_constraint_name);
 
-    (defined $base_type && defined $type_parameter)
+    (defined $base_type && defined $type_parameter_str)
         || Moose->throw_error("Could not parse type name ($type_constraint_name) correctly");
 
-    ($REGISTRY->has_type_constraint($base_type))
-        || Moose->throw_error("Could not locate the base type ($base_type)");
+    if ($REGISTRY->has_type_constraint($base_type)) {
+        my $base_type_tc = $REGISTRY->get_type_constraint($base_type);
+        return _create_parameterized_type_constraint(
+            $type_constraint_name,
+            $base_type_tc,
+            $type_parameter_str,
+        );
+    } else {
+        Moose->throw_error("Could not locate the base type ($base_type)");
+    }
+}
 
-    return Moose::Meta::TypeConstraint::Parameterized->new(
-        name           => $type_constraint_name,
-        parent         => $REGISTRY->get_type_constraint($base_type),
-        type_parameter => find_or_create_isa_type_constraint($type_parameter),
-    );
+sub _create_parameterized_type_constraint {
+    my ($tc_name, $base_type_tc, $type_parameter_str) = @_;
+    my @type_parameters_tc = map {find_or_create_isa_type_constraint($_)} ($type_parameter_str);
+    if($base_type_tc->can('parameterize')) {
+        return $base_type_tc->parameterize($tc_name,@type_parameters_tc);
+    } else {
+        return Moose::Meta::TypeConstraint::Parameterized->new(
+            name           => $tc_name,
+            parent         => $base_type_tc,
+            type_parameter => $type_parameters_tc[0],
+        );
+    } 
 }
 
 #should we also support optimized checks?

diff --git a/t/040_type_constraints/010_misc_type_tests.t b/t/040_type_constraints/010_misc_type_tests.t
index adbd0db..75e2fb8 100644 (file)
--- a/t/040_type_constraints/010_misc_type_tests.t
+++ b/t/040_type_constraints/010_misc_type_tests.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 8;
+use Test::More tests => 19;
 use Test::Exception;
 
 BEGIN {
@@ -51,14 +51,75 @@ ok $subtype2 => 'made a subtype of our subtype';
 # testing the parameterize method
 
 {
-       package Test::Moose::Meta::TypeConstraint::Parameterizable;
-       
-       use Moose;
-       use Moose::Util::TypeConstraints;
-       
        my $parameterizable = subtype 'parameterizable_hashref',
                as 'HashRef';
                
        my $parameterized = subtype 'parameterized_hashref',
                as 'HashRef[Int]';
-}
\ No newline at end of file
+               
+       my $int = Moose::Util::TypeConstraints::find_type_constraint('Int');
+               
+       my $from_parameterizable = $parameterizable->parameterize($int);
+       
+       isa_ok $parameterizable, 'Moose::Meta::TypeConstraint::Parameterizable',
+        => 'Got expected type instance';
+
+       package Test::Moose::Meta::TypeConstraint::Parameterizable;
+       use Moose;
+       
+       has parameterizable => (is=>'rw', isa=>$parameterizable);
+       has parameterized => (is=>'rw', isa=>$parameterized);
+       has from_parameterizable => (is=>'rw', isa=>$from_parameterizable);
+}
+
+# Create and check a dummy object
+
+ok my $params = Test::Moose::Meta::TypeConstraint::Parameterizable->new()
+ => 'Create Dummy object for testing';
+ 
+isa_ok $params, 'Test::Moose::Meta::TypeConstraint::Parameterizable'
+ => 'isa correct type';
+
+# test parameterizable
+
+lives_ok sub {
+       $params->parameterizable({a=>'Hello', b=>'World'});
+} => 'No problem setting parameterizable';
+
+is_deeply $params->parameterizable, {a=>'Hello', b=>'World'}
+ => 'Got expected values';
+
+# test parameterized
+
+lives_ok sub {
+       $params->parameterized({a=>1, b=>2});
+} => 'No problem setting parameterized';
+
+is_deeply $params->parameterized, {a=>1, b=>2}
+ => 'Got expected values';
+ 
+throws_ok sub {
+       $params->parameterized({a=>'Hello', b=>'World'});
+}, qr/Attribute \(parameterized\) does not pass the type constraint/
+ => 'parameterized throws expected error';
+
+# test from_parameterizable
+
+lives_ok sub {
+       $params->from_parameterizable({a=>1, b=>2});
+} => 'No problem setting from_parameterizable';
+
+is_deeply $params->from_parameterizable, {a=>1, b=>2}
+ => 'Got expected values';
+ 
+throws_ok sub {
+       $params->from_parameterizable({a=>'Hello', b=>'World'});
+}, qr/Attribute \(from_parameterizable\) does not pass the type constraint/
+ => 'from_parameterizable throws expected error';
+ 
+ 
+ 
+ 
+ 
+ 
+ 
\ No newline at end of file