From: John Napiorkowski <jjnapiork@cpan.org>
Date: Sun, 24 Aug 2008 03:21:18 +0000 (+0000)
Subject: trying to get some tests in place that reflect the desired effect and got a start... 
X-Git-Tag: 0.06~4^2~19
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types.git;a=commitdiff_plain;h=20b6a7d178dbaa6cd1ba946e53c1a4af3a4006eb

trying to get some tests in place that reflect the desired effect and got a start on impl.  also fixed brain dead mistake trying to create handlers for the decorator object.
---

diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm
index c56d45e..f1dc7f5 100644
--- a/lib/MooseX/Types.pm
+++ b/lib/MooseX/Types.pm
@@ -304,14 +304,14 @@ sub type_export_generator {
     my ($class, $type, $full) = @_;
     return sub {
         my @args = @_;
-        use Data::Dump qw/dump/; warn dump @args if @args;
+        #use Data::Dump qw/dump/; warn dump @args if @args;
         my $type_constraint = find_type_constraint($full)
          || MooseX::Types::UndefinedType->new($full);
          
         if(@args) {
             my $tc = $args[0]->[0];
-            warn dump $tc;
-            $type_constraint->type_constraint($tc);
+           # warn dump $tc;
+           # $type_constraint->type_constraint($tc);
         }
         return MooseX::Types::TypeDecorator->new(type_constraint=>$type_constraint);
     };
diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index 42cd141..1d9d776 100644
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -1,13 +1,14 @@
 package MooseX::Types::TypeDecorator;
 
 use Moose;
-use Moose::Util::TypeConstraints;
+use Moose::Util::TypeConstraints ();
 use Moose::Meta::TypeConstraint ();
 
 use overload(
     '""' => sub {
         shift->type_constraint->name;  
     },
+    '&' => sub {warn 'got code context'},
 );
 
 =head1 NAME
@@ -29,7 +30,7 @@ Used to make sure we can properly validate incoming type constraints.
 
 =cut
 
-class_type 'Moose::Meta::TypeConstraint';
+Moose::Util::TypeConstraints::class_type 'Moose::Meta::TypeConstraint';
 
 =head2 MooseX::Types::UndefinedType
 
@@ -37,7 +38,7 @@ Used since sometimes our constraint is an unknown type.
 
 =cut
 
-class_type 'MooseX::Types::UndefinedType';
+Moose::Util::TypeConstraints::class_type 'MooseX::Types::UndefinedType';
 
 =head1 ATTRIBUTES
 
@@ -53,8 +54,11 @@ has 'type_constraint' => (
     is=>'ro',
     isa=>'Moose::Meta::TypeConstraint|MooseX::Types::UndefinedType',
     handles=>[
-        Moose::Meta::TypeConstraint->meta->compute_all_applicable_methods,
-        "_compiled_type_constraint",
+        grep {
+            $_ ne 'meta' && $_ ne '(""';
+        } map {
+            $_->{name};
+        } Moose::Meta::TypeConstraint->meta->compute_all_applicable_methods,
     ],
 );
 
diff --git a/t/13_typedecorator.t b/t/13_typedecorator.t
index 8afec9d..79d95a1 100644
--- a/t/13_typedecorator.t
+++ b/t/13_typedecorator.t
@@ -2,11 +2,60 @@
 use warnings;
 use strict;
 
-use Test::More tests => 1;
+use Test::More tests => 10;
 use FindBin;
 use lib "$FindBin::Bin/lib";
-use DecoratorLibrary qw( ArrayOfInts);
 
-is 1,1, 'ok';
+{
+    package Test::MooseX::TypeLibrary::TypeDecorator;
+    
+    use Moose;
+    use DecoratorLibrary qw(
+        MyArrayRefBase
+        MyArrayRefInt01
+        MyArrayRefInt02
+    );
+    
+    has 'arrayrefbase' => (is=>'rw', isa=>MyArrayRefBase, coerce=>1);
+    has 'arrayrefint01' => (is=>'rw', isa=>MyArrayRefInt01, coerce=>1);
+}
 
-use Data::Dump qw/dump/;
+## Make sure we have a 'create object sanity check'
+
+ok my $type = Test::MooseX::TypeLibrary::TypeDecorator->new(),
+ => 'Created some sort of object';
+ 
+isa_ok $type, 'Test::MooseX::TypeLibrary::TypeDecorator'
+ => "Yes, it's the correct kind of object";
+
+## test arrayrefbase normal and coercion
+
+ok $type->arrayrefbase([qw(a b c)])
+ => 'Assigned arrayrefbase qw(a b c)';
+ 
+is_deeply $type->arrayrefbase, [qw(a b c)],
+ => 'Assigment is correct';
+
+ok $type->arrayrefbase('d,e,f')
+ => 'Assigned arrayrefbase d,e,f to test coercion';
+ 
+is_deeply $type->arrayrefbase, [qw(d e f)],
+ => 'Assigment and coercion is correct';
+
+## test arrayrefint01 normal and coercion
+
+ok $type->arrayrefint01([qw(a b c)])
+ => 'Assigned arrayrefbase qw(a b c)';
+ 
+is_deeply $type->arrayrefint01, [qw(a b c)],
+ => 'Assigment is correct';
+
+ok $type->arrayrefint01('d.e.f')
+ => 'Assigned arrayrefbase d,e,f to test coercion';
+ 
+is_deeply $type->arrayrefint01, [qw(d e f)],
+ => 'Assigment and coercion is correct';
+
+#use Data::Dump qw/dump/;
+#warn dump  MyArrayRefInt01;
+#warn dump MyArrayRefBase->validate('aaa,bbb,ccc');
diff --git a/t/lib/DecoratorLibrary.pm b/t/lib/DecoratorLibrary.pm
new file mode 100644
index 0000000..7912331
--- /dev/null
+++ b/t/lib/DecoratorLibrary.pm
@@ -0,0 +1,40 @@
+package DecoratorLibrary;
+
+use warnings;
+use strict;
+
+use MooseX::Types::Moose qw( Str ArrayRef HashRef Int );
+use MooseX::Types
+    -declare => [qw(
+        MyArrayRefBase
+        MyArrayRefInt01
+        MyArrayRefInt02
+    )];
+
+subtype MyArrayRefBase,
+    as ArrayRef;
+    
+coerce MyArrayRefBase,
+    from Str,
+    via {[split(',', $_)]};
+    
+subtype MyArrayRefInt01,
+    as ArrayRef[Int];
+
+coerce MyArrayRefInt01,
+    from Str,
+    via {[split('\.',$_)]},
+    from HashRef,
+    via {[values(%$_)]};
+    
+subtype MyArrayRefInt02,
+    as MyArrayRefBase[Int];
+
+coerce MyArrayRefInt02,
+    from Str,
+    via {[split(':',$_)]};
+    from HashRef[Int],
+    via {[values(%$_)]},
+    from HashRef[Str],
+    via {[ map { length $_ } values(%_) ]};
+1;