release

diff --git a/Changes b/Changes
index 412812d..38696df 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for MooseX-Types
 
-        - fix coercions on parameterized types (Rafael Kitover)
+0.18    Sat Aug 22 12:50:42 EDT 2009
+        - fix coercions on parameterized types (Hans Dieter Pearcey).
 
 0.17    Tue Aug 18 02:32:31 EDT 2009
         - Documentation typo fix (Dave Rolsky).

diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm
index 9528d36..1b12bc2 100644 (file)
--- a/lib/MooseX/Types.pm
+++ b/lib/MooseX/Types.pm
@@ -20,7 +20,7 @@ use Scalar::Util                      'reftype';
 use namespace::clean -except => [qw( meta )];
 
 use 5.008;
-our $VERSION = '0.17';
+our $VERSION = '0.18';
 my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'};
 
 =head1 SYNOPSIS
@@ -425,16 +425,18 @@ it with @args.
 =cut
 
 sub create_arged_type_constraint {
-    my ($class, $name, $arg) = @_;  
-
-    my $container_tc =
-       Moose::Util::TypeConstraints::find_or_create_type_constraint("$name");
-    my $contained_tc =
-       Moose::Util::TypeConstraints::find_or_create_type_constraint("$arg");
-
-    my $tc_name = $container_tc->name . '[' . $contained_tc->name .  ']';
-
-    return Moose::Util::TypeConstraints::find_or_create_type_constraint($tc_name);
+    my ($class, $name, @args) = @_;  
+    my $type_constraint = Moose::Util::TypeConstraints::find_or_create_type_constraint("$name");
+    my $parameterized = $type_constraint->parameterize(@args);
+    # It's obnoxious to have to parameterize before looking for the TC, but the
+    # alternative is to hard-code the assumption that the name is
+    # "$name[$args[0]]", which would be worse.
+    if (my $existing =
+        Moose::Util::TypeConstraints::find_type_constraint($parameterized->name)) {
+        return $existing;
+    }
+    Moose::Util::TypeConstraints::register_type_constraint($parameterized);
+    return $parameterized;
 }
 
 =head2 create_base_type_constraint ($name)
@@ -591,6 +593,8 @@ caelum: Rafael Kitover <rkitover@cpan.org>
 
 rafl: Florian Ragwitz <rafl@debian.org>
 
+hdp: Hans Dieter Pearcey <hdp@cpan.org>
+
 =head1 COPYRIGHT & LICENSE
 
 Copyright (c) 2007-2009 Robert Sedlacek

diff --git a/t/21_coerce_parameterized_types.t b/t/21_coerce_parameterized_types.t
index 08df149..31e4c8c 100644 (file)
--- a/t/21_coerce_parameterized_types.t
+++ b/t/21_coerce_parameterized_types.t
@@ -7,7 +7,9 @@ use Test::More tests => 2;
 
 BEGIN {
     package TypeLib;
-    use MooseX::Types -declare => [qw/MyChar MyDigit ArrayRefOfMyCharOrDigit/];
+    use MooseX::Types -declare => [qw/
+       MyChar MyDigit ArrayRefOfMyCharOrDigit
+    /];
     use MooseX::Types::Moose qw/ArrayRef Str Int/;
 
     subtype MyChar, as Str, where {
@@ -32,11 +34,13 @@ BEGIN {
 {
     package AClass;
     use Moose;
-    BEGIN { TypeLib->import(qw/MyChar MyDigit ArrayRefOfMyCharOrDigit/) };
+    BEGIN { TypeLib->import(qw/
+       MyChar MyDigit ArrayRefOfMyCharOrDigit/
+    ) };
     use MooseX::Types::Moose 'ArrayRef';
 
     has parameterized => (is => 'rw', isa => ArrayRef[MyChar|MyDigit], coerce => 1);
-    has subtype => (is => 'rw', isa => ArrayRefOfMyCharOrDigit, coerce => 1);
+    has subtype_parameterized => (is => 'rw', isa => ArrayRefOfMyCharOrDigit, coerce => 1);
 }
 
 my $instance = AClass->new;
@@ -44,4 +48,5 @@ my $instance = AClass->new;
 lives_ok { $instance->parameterized('foo') }
     'coercion applied to parameterized type';
 
-lives_ok { $instance->subtype('foo') } 'coercion applied to subtype';
+lives_ok { $instance->subtype_parameterized('foo') }
+    'coercion applied to subtype';