use ISO-8601 date formats, for better machine parsing

[gitmo/MooseX-Types-Structured.git] / t / 01-basic.t

diff --git a/t/01-basic.t b/t/01-basic.t
old mode 100755 (executable)
new mode 100644 (file)
index 90e31ff..184b82f
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -1,47 +1,48 @@
-BEGIN {
-       use strict;
-       use warnings;
-       use Test::More tests=>4;
-       use Test::Exception;
-       
-       use_ok 'Moose::Util::TypeConstraints';
-       use_ok 'MooseX::Meta::TypeConstraint::Structured::Positionable';        
-}
-
-ok my $REGISTRY = Moose::Meta::TypeConstraint::Registry->new
- => 'Got a registry';
- 
-my $tuple = MooseX::Meta::TypeConstraint::Structured::Positionable->new(
-               name => 'Tuple',
-               package_defined_in => __PACKAGE__,
-               parent => find_type_constraint('Ref'),
-       );
-
-
-type('Tuple', $tuple);
-
-
-
-
-use Data::Dump qw/dump/;
-#warn dump sort {$a cmp $b} Moose::Util::TypeConstraints::list_all_type_constraints;
-
-
-{
-       package Test::MooseX::Types::Structured::Positionable;
-       use Moose;
-       
-       has 'attr' => (is=>'rw', isa=>'Tuple[Int,Str,Int]');
-       
-}
-
-ok my $positioned_obj = Test::MooseX::Types::Structured::Positionable->new,
- => 'Got a good object';
-
-## should be good
-$positioned_obj->attr([1,'hello',3]);
-
-## should all fail
-$positioned_obj->attr([1,2,'world']);
-$positioned_obj->attr(['hello',2,3]);
-$positioned_obj->attr(['hello',2,'world']);
\ No newline at end of file
+use strict;
+use warnings;
+
+use Test::More tests=>14;
+
+use_ok 'MooseX::Meta::TypeConstraint::Structured';
+use_ok 'Moose::Util::TypeConstraints';
+
+ok my $int = find_type_constraint('Int') => 'Got Int';
+ok my $str = find_type_constraint('Str') => 'Got Str';
+ok my $arrayref = find_type_constraint('ArrayRef') => 'Got ArrayRef';
+
+my $list_tc = MooseX::Meta::TypeConstraint::Structured->new(
+    name => 'list_tc',
+    parent => $arrayref,
+    type_constraints => [$int, $str],
+    constraint_generator=> sub {
+        my ($self) = @_;
+        my @type_constraints = @{ $self->type_constraints };
+
+        return sub {
+            my ($values, $err) = @_;
+            my @values = @$values;
+
+            for my $type_constraint (@type_constraints) {
+                my $value = shift @values || return;
+                $type_constraint->check($value) || return;
+            }
+            if(@values) {
+                return;
+            } else {
+                return 1;
+            }
+        }
+    }
+);
+
+isa_ok $list_tc, 'MooseX::Meta::TypeConstraint::Structured';
+
+ok !$arrayref->check() => 'Parent undef fails';
+ok !$list_tc->check() => 'undef fails';
+ok !$list_tc->check(1) => '1 fails';
+ok !$list_tc->check([]) => '[] fails';
+ok !$list_tc->check([1]) => '[1] fails';
+ok !$list_tc->check([1,2,3]) => '[1,2,3] fails';
+ok !$list_tc->check(['a','b']) => '["a","b"] fails';
+
+ok $list_tc->check([1,'a']) => '[1,"a"] passes';