stub for api test, example and warnings about extending subtypes, fixes to the makefi...

diff --git a/Makefile.PL b/Makefile.PL
index 28a8e4f..a875e8f 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -10,8 +10,8 @@ license 'perl';
 perl_version '5.8.8';
 
 ## Module dependencies
-requires 'Moose' => '0.58';
-requires 'MooseX::Types' => '';
+requires 'Moose' => '0.60';
+requires 'MooseX::Types' => '0.06';
 
 ## Testing dependencies
 build_requires 'Test::More' => '0.70';

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured.pm b/lib/MooseX/Meta/TypeConstraint/Structured.pm
index 10bb30a..f161a7a 100644 (file)
--- a/lib/MooseX/Meta/TypeConstraint/Structured.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Structured.pm
@@ -104,6 +104,30 @@ around 'compile_type_constraint' => sub {
     return $self->$compile_type_constraint(@args);
 };
 
+=head2 create_child_type
+
+modifier to make sure we get the constraint_generator
+
+=cut
+
+around 'create_child_type' => sub {
+    my ($create_child_type, $self, %opts) = @_;
+    return $self->$create_child_type(
+        %opts,
+        constraint_generator => $self->constraint_generator,
+    );
+};
+
+=head2 is_a_type_of
+
+=head2 is_subtype_of
+
+=head2 equals
+
+=head2 get_message
+
+Want to override this to set a more useful error message
+
 =head1 SEE ALSO
 
 The following modules or resources may be of interest.

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index a4c6be6..ab543ed 100644 (file)
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -102,11 +102,21 @@ method, granting some interesting possibilities for coercion.  Try:
                        name=>$name,
                        age=>$age->years );
         };
-       
-
-=head1 METHODS
+        
+You also need to exercise some care when you try to structure a structured type
+as in this example:
 
-This class defines the following methods
+       subtype Person,
+        as Dict[name=>Str, age=>iIt];
+        
+       subtype FriendlyPerson,
+        as Person[name=>Str, age=>Int, totalFriends=>Int];
+        
+This will actually work BUT you have to take care the the subtype has a
+structure that does not contradict the structure of it's parent.  For now the
+above works, but I will probably clarify how this works at a future point, so
+it's recommended to avoid (should not realy be needed so much anyway).  For
+now this is supported in an EXPERIMENTAL way.
 
 =cut
 

diff --git a/t/05-advanced.t b/t/05-advanced.t
index be161e2..76cd134 100644 (file)
--- a/t/05-advanced.t
+++ b/t/05-advanced.t
@@ -41,8 +41,7 @@ BEGIN {
     
     ## Dict key overloading
     subtype MorePersonalInfo,
-    # as PersonalInfo[name=>MinFiveChars];
-     as PersonalInfo;
+     as PersonalInfo[name=>MinFiveChars, stats=>MoreLengthPlease|Object];
     
     has 'EqualLengthAttr' => (is=>'rw', isa=>EqualLength);
     has 'MoreLengthPleaseAttr' => (is=>'rw', isa=>MoreLengthPlease);
@@ -126,12 +125,9 @@ throws_ok sub {
 }, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
  => q{MorePersonalInfo correctly fails name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
 
-SKIP: {
-    skip 'not yet working', 1;
-    
-    throws_ok sub {
-        $obj->MorePersonalInfo({name=>'abc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});    
-    }, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
-     => q{MorePersonalInfo correctly fails name=>'aaa', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]};   
-}
+throws_ok sub {
+    $obj->MorePersonalInfo({name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});    
+}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
+ => q{MorePersonalInfo correctly fails name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]};   
+
 

diff --git a/t/06-api.t b/t/06-api.t
new file mode 100644 (file)
index 0000000..00c7686
--- /dev/null
+++ b/t/06-api.t
@@ -0,0 +1,69 @@
+BEGIN {
+       use strict;
+       use warnings;
+       use Test::More tests=>12;
+       use Test::Exception;
+}
+
+{
+       ## Tests for the Moose::Meta::TypeConstraints API stuff (equals, etc)
+    package Test::MooseX::Meta::TypeConstraint::Structured::API;
+
+    use Moose;
+    use MooseX::Types::Structured qw(Dict Tuple);
+       use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef);
+       use MooseX::Types -declare => [qw(
+        MyDict1 MyDict2 MyDict3 subMyDict3
+               MyTuple1 MyTuple2 MyTuple3 subMyTuple3
+    )];
+    
+       ## Create some sample Dicts
+       
+    my $MyDict1 = subtype MyDict1,
+     as Dict[name=>Str, age=>Int];
+       
+    my $MyDict2 = subtype MyDict2,
+     as Dict[name=>Str, age=>Int];
+        
+    my $MyDict3 = subtype MyDict3,
+     as Dict[key=>Int, anotherkey=>Str];
+        
+       my $subMyDict3 = subtype subMyDict3,
+        as MyDict3;
+
+       ## Create some sample Tuples
+       
+       my $MyTuple1 = subtype MyTuple1,
+        as Tuple[Int,Int,Str];
+
+       my $MyTuple2 = subtype MyTuple2,
+        as Tuple[Int,Int,Str];
+        
+       my $MyTuple3 = subtype MyTuple3,
+        as Tuple[Object, HashRef];
+
+       my $subMyTuple3 = subtype subMyTuple3,
+        as MyTuple3;
+}
+
+## Test equals
+
+ok $MyDict1->equals($MyDict2), '$MyDict1 == $MyDict2';
+ok $MyDict2->equals($MyDict1), '$MyDict2 == $MyDict1';
+ok ! $MyDict1->equals($MyDict3), '$MyDict1 == $MyDict3';
+ok ! $MyDict2->equals($MyDict3), '$MyDict2 == $MyDict3';
+ok ! $MyDict3->equals($MyDict2), '$MyDict3 == $MyDict2';
+ok ! $MyDict3->equals($MyDict1), '$MyDict3 == $MyDict1';
+
+ok $MyTuple1->equals($MyTuple2), '$MyTuple1 == $MyTuple2';
+ok $MyTuple2->equals($MyTuple1), '$MyTuple2 == $MyTuple1';
+ok ! $MyTuple1->equals($MyTuple3), '$MyTuple1 == $MyTuple3';
+ok ! $MyTuple2->equals($MyTuple3), '$MyTuple2 == $MyTuple3';
+ok ! $MyTuple3->equals($MyTuple2), '$MyTuple3 == $MyTuple2';
+ok ! $MyTuple3->equals($MyTuple1), '$MyTuple3 == $MyTuple1';
+
+## Test is_a_type_of
+
+## is_subtype_of
+
+