isa and can, more tests, but not it breaks due to some wierdness with isa

diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm
index e8c20ac..0f6e7a8 100644 (file)
--- a/lib/MooseX/Types.pm
+++ b/lib/MooseX/Types.pm
@@ -315,8 +315,8 @@ sub type_export_generator {
         }
         $type_constraint = defined($type_constraint) ? $type_constraint
          : MooseX::Types::UndefinedType->new($name);
-         
-        return $class->create_type_decorator($type_constraint);
+        
+        return $class->create_type_decorator($type_constraint);  
     };
 }
 

diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index 99cfeda..f39bd55 100644 (file)
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -3,17 +3,18 @@ package MooseX::Types::TypeDecorator;
 use strict;
 use warnings;
 
+use Carp::Clan qw( ^MooseX::Types );
 use Moose::Util::TypeConstraints;
+use Moose::Meta::TypeConstraint::Union;
+
 use overload(
     '""' => sub {
         shift->type_constraint->name;  
     },
     '|' => sub {
-        my @names = grep {$_} map {"$_"} @_;
-        ## Don't know why I can't use the array version of this...  If someone
-        ## knows would like to hear from you.
-        my $names = join('|', @names);
-        Moose::Util::TypeConstraints::create_type_constraint_union($names);
+        my @tc = grep {ref $_} @_;
+        my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
+        return Moose::Util::TypeConstraints::register_type_constraint($union);
     },
 );
 
@@ -38,7 +39,16 @@ Old school instantiation
 
 sub new {
     my ($class, %args) = @_;
-    return bless \%args, $class;
+    if(
+        $args{type_constraint} && ref($args{type_constraint}) &&
+        ($args{type_constraint}->isa('Moose::Meta::TypeConstraint') ||
+        $args{type_constraint}->isa('MooseX::Types::UndefinedType'))
+    ) {
+        return bless \%args, $class;        
+    } else {
+        croak "The argument 'type_constraint' is not valid.";
+    }
+
 }
 
 =head type_constraint ($type_constraint)
@@ -55,6 +65,38 @@ sub type_constraint {
     return $self->{type_constraint};
 }
 
+=head2 isa
+
+handle $self->isa since AUTOLOAD can't.
+
+=cut
+
+sub isa {
+    my ($self, $target) = @_;
+    if(defined $target) {
+        my $isa = $self->type_constraint->isa($target);
+        return $isa;
+    } else {
+        return;
+    }
+}
+
+=head2 can
+
+handle $self->can since AUTOLOAD can't.
+
+=cut
+
+sub can {
+    my ($self, $target) = @_;
+    if(defined $target) {
+        my $can = $self->type_constraint->can($target);
+        return $can;
+    } else {
+        return;
+    }
+}
+
 =head2 DESTROY
 
 We might need it later

diff --git a/t/13_typedecorator.t b/t/13_typedecorator.t
index da2c5cd..cc600f4 100644 (file)
--- a/t/13_typedecorator.t
+++ b/t/13_typedecorator.t
@@ -39,10 +39,10 @@ isa_ok $type, 'Test::MooseX::TypeLibrary::TypeDecorator'
 
 ## test arrayrefbase normal and coercion
 
-ok $type->arrayrefbase([qw(a b c)])
- => 'Assigned arrayrefbase qw(a b c)';
+ok $type->arrayrefbase([qw(a b c d e)])
+ => 'Assigned arrayrefbase qw(a b c d e)';
  
-is_deeply $type->arrayrefbase, [qw(a b c)],
+is_deeply $type->arrayrefbase, [qw(a b c d e)],
  => 'Assignment is correct';
 
 ok $type->arrayrefbase('d,e,f')