From: John Napiorkowski Date: Fri, 26 Sep 2008 11:57:48 +0000 (+0000) Subject: rollback some stuff to reset my brain a bit X-Git-Tag: 0.01~12 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types-Structured.git;a=commitdiff_plain;h=78f559467710da345f5d08c2fea40da4d75ed8ee rollback some stuff to reset my brain a bit --- diff --git a/lib/MooseX/Meta/TypeConstraint/Structured/Named.pm b/lib/MooseX/Meta/TypeConstraint/Structured/Named.pm index bcbc996..ee4b195 100644 --- a/lib/MooseX/Meta/TypeConstraint/Structured/Named.pm +++ b/lib/MooseX/Meta/TypeConstraint/Structured/Named.pm @@ -95,12 +95,6 @@ sub constraint { my $self = shift; return sub { my %args = $self->_normalize_args(shift); - my @optional_signature; - - if($signature[-1]->isa('MooseX::Meta::TypeConstraint::Structured::Optional')) { - my $optional = pop @signature; - @optional_signature = @{$optional->signature}; - } ## First make sure all the required type constraints match foreach my $sig_key (keys %{$self->signature}) { diff --git a/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm b/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm index 4936743..d29ed46 100644 --- a/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm +++ b/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm @@ -94,12 +94,8 @@ sub constraint { return sub { my @args = $self->_normalize_args(shift); my @signature = @{$self->signature}; - my @optional_signature; - - if($signature[-1]->isa('MooseX::Meta::TypeConstraint::Structured::Optional')) { - my $optional = pop @signature; - @optional_signature = @{$optional->signature}; - } + my @optional_signature = @{$self->optional_signature} + if $self->has_optional_signature; ## First make sure all the required type constraints match while( my $type_constraint = shift @signature) { @@ -124,55 +120,6 @@ sub constraint { }; } -=head2 _parse_type_parameter ($str) - -Given a $string that is the parameter information part of a parameterized -constraint, parses it for internal constraint information. For example: - - MyType[Int,Int,Str] - -has a parameter string of "Int,Int,Str" (whitespace will automatically be -removed during normalization that happens in L) -and we need to convert that to ['Int','Int','Str'] which then has any type -constraints converted to true objects. - -=cut - -{ - use re "eval"; - - my $any; - my $valid_chars = qr{[\w:]}; - my $type_atom = qr{ $valid_chars+ }; - - my $type = qr{ $valid_chars+ (?: \[ (??{$any}) \] )? }x; - my $type_capture_parts = qr{ ($valid_chars+) (?: \[ ((??{$any})) \] )? }x; - my $type_with_parameter = qr{ $valid_chars+ \[ (??{$any}) \] }x; - - my $op_union = qr{ \s* \| \s* }x; - my $union = qr{ $type (?: $op_union $type )+ }x; - - ## New Stuff for structured types. - my $comma = qr{,}; - my $indirection = qr{=>}; - my $divider_ops = qr{ $comma | $indirection }x; - my $structure_divider = qr{\s* $divider_ops \s*}x; - my $structure_elements = qr{ $valid_chars+ $structure_divider $type | $union }x; - - $any = qr{ $union | $structure_elements+ | $type }x; - - sub _parse_type_parameter { - my ($class, $type_str) = @_; - { - $any; - my @type_strs = ($type_str=~m/$union | $type/gx); - return map { - Moose::Util::TypeConstraints::find_or_create_type_constraint($_); - } @type_strs; - } - } -} - =head2 signature_equals Check that the signature equals another signature. diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm index 2bb42a0..67d3f46 100644 --- a/lib/MooseX/Types/Structured.pm +++ b/lib/MooseX/Types/Structured.pm @@ -134,12 +134,13 @@ sub Tuple($) { } @optional], ); } - +use Data::Dump qw/dump/; sub Dict($) { my ($args, $optional) = _normalize_args(@_); my %args = @$args; my %optional = ref $optional eq 'ARRAY' ? @$optional : (); + return MooseX::Meta::TypeConstraint::Structured::Named->new( name => 'Dict', parent => find_type_constraint('HashRef'), @@ -148,7 +149,13 @@ sub Dict($) { $_ => _normalize_type_constraint($args{$_}); } keys %args}, optional_signature => {map { + + warn dump $_; + warn dump $optional{$_}; + warn dump _normalize_type_constraint($optional{$_}); + $_ => _normalize_type_constraint($optional{$_}); + } keys %optional}, ); } @@ -169,8 +176,8 @@ sub _normalize_args { } sub _normalize_type_constraint { - my $tc = shift @_; - + my ($tc) = @_; + ## If incoming is an object, we will assume it's something that implements ## what a type constraint is. We should probably have a Role for this... if(defined $tc && blessed $tc) { diff --git a/t/01-basic.t b/t/01-basic.t index 7a108b9..a4c3f74 100755 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -1,7 +1,7 @@ BEGIN { use strict; use warnings; - use Test::More tests=>36; + use Test::More tests=>37; use Test::Exception; use_ok 'Moose::Util::TypeConstraints'; @@ -58,16 +58,14 @@ ok Moose::Util::TypeConstraints::find_type_constraint('Optional') has 'tuple_with_optional' => (is=>'rw', isa=>'Tuple[Int,Str,Int,Optional[Int,Int]]'); has 'tuple_with_union' => (is=>'rw', isa=>'Tuple[Int,Str,Int|Object,Optional[Int|Object,Int]]'); - has 'dict' => (is=>'rw', isa=>'Dict[name=>Str, Age=>Int]'); - has 'dict_with_parameterized' => (is=>'rw', isa=>'Dict[name=>Str, Age=>Int, telephone=>ArrayRef[Int]]'); - has 'dict_with_optional' => (is=>'rw', isa=>'Dict[name=>Str, Age=>Int, Optional[opt1=>Str,Opt2=>Object]]'); + has 'dict' => (is=>'rw', isa=>'Dict[name=>Str,age=>Int]'); + has 'dict_with_parameterized' => (is=>'rw', isa=>'Dict[name=>Str, age=>Int, telephone=>ArrayRef[Int]]'); + has 'dict_with_optional' => (is=>'rw', isa=>'Dict[name=>Str, age=>Int, Optional[opt1=>Str,opt2=>Object]]'); } -#use Data::Dump qw/dump/; -#warn dump Moose::Util::TypeConstraints::list_all_type_constraints; -ok my $positioned_obj = Test::MooseX::Types::Structured::BasicAttributes->new, +ok my $obj = Test::MooseX::Types::Structured::BasicAttributes->new, => 'Got a good object'; ok Moose::Util::TypeConstraints::find_type_constraint('Tuple[Int,Str,Int]') @@ -76,74 +74,84 @@ ok Moose::Util::TypeConstraints::find_type_constraint('Tuple[Int,Str,Int]') ok Moose::Util::TypeConstraints::find_type_constraint('Tuple[Int,Str,Int,Optional[Int,Int]]') => 'Found expected type constraint'; +## dict Dict[name=>Str, Age=>Int] + +ok $obj->dict({name=>'John', age=>39}) + => 'Dict[name=>Str, Age=>Int] properly succeeds'; + + + + + + ## Test tuple (Tuple[Int,Str,Int]) -ok $positioned_obj->tuple([1,'hello',3]) +ok $obj->tuple([1,'hello',3]) => "[1,'hello',3] properly suceeds"; throws_ok sub { - $positioned_obj->tuple([1,2,'world']); + $obj->tuple([1,2,'world']); }, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails"; throws_ok sub { - $positioned_obj->tuple(['hello1',2,3]); + $obj->tuple(['hello1',2,3]); }, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails"; throws_ok sub { - $positioned_obj->tuple(['hello2',2,'world']); + $obj->tuple(['hello2',2,'world']); }, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails"; ## Test tuple_with_parameterized (Tuple[Int,Str,Int,ArrayRef[Int]]) -ok $positioned_obj->tuple_with_parameterized([1,'hello',3,[1,2,3]]) +ok $obj->tuple_with_parameterized([1,'hello',3,[1,2,3]]) => "[1,'hello',3,[1,2,3]] properly suceeds"; throws_ok sub { - $positioned_obj->tuple_with_parameterized([1,2,'world']); + $obj->tuple_with_parameterized([1,2,'world']); }, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails"; throws_ok sub { - $positioned_obj->tuple_with_parameterized(['hello1',2,3]); + $obj->tuple_with_parameterized(['hello1',2,3]); }, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails"; throws_ok sub { - $positioned_obj->tuple_with_parameterized(['hello2',2,'world']); + $obj->tuple_with_parameterized(['hello2',2,'world']); }, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails"; throws_ok sub { - $positioned_obj->tuple_with_parameterized([1,'hello',3,[1,2,'world']]); + $obj->tuple_with_parameterized([1,'hello',3,[1,2,'world']]); }, qr/Validation failed for 'ArrayRef\[Int\]'/ => "[1,'hello',3,[1,2,'world']] properly fails"; ## Test tuple_with_optional (Tuple[Int,Str,Int,Optional[Int,Int]]) -ok $positioned_obj->tuple_with_optional([1,'hello',3]) +ok $obj->tuple_with_optional([1,'hello',3]) => "[1,'hello',3] properly suceeds"; -ok $positioned_obj->tuple_with_optional([1,'hello',3,1]) +ok $obj->tuple_with_optional([1,'hello',3,1]) => "[1,'hello',3,1] properly suceeds"; -ok $positioned_obj->tuple_with_optional([1,'hello',3,4]) +ok $obj->tuple_with_optional([1,'hello',3,4]) => "[1,'hello',3,4] properly suceeds"; -ok $positioned_obj->tuple_with_optional([1,'hello',3,4,5]) +ok $obj->tuple_with_optional([1,'hello',3,4,5]) => "[1,'hello',3,4,5] properly suceeds"; throws_ok sub { - $positioned_obj->tuple_with_optional([1,'hello',3,4,5,6]); + $obj->tuple_with_optional([1,'hello',3,4,5,6]); }, qr/Too Many arguments for the available type constraints/ => "[1,'hello',3,4,5,6] properly fails"; throws_ok sub { - $positioned_obj->tuple_with_optional([1,2,'world']); + $obj->tuple_with_optional([1,2,'world']); }, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails"; throws_ok sub { - $positioned_obj->tuple_with_optional(['hello1',2,3]); + $obj->tuple_with_optional(['hello1',2,3]); }, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails"; throws_ok sub { - $positioned_obj->tuple_with_optional(['hello2',2,'world']); + $obj->tuple_with_optional(['hello2',2,'world']); }, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails"; ## tuple_with_union Tuple[Int,Str,Int|Object,Optional[Int|Object,Int]] @@ -152,32 +160,32 @@ SKIP: { skip "Unions not supported for string parsed type constraints" => 8; - ok $positioned_obj->tuple_with_union([1,'hello',3]) + ok $obj->tuple_with_union([1,'hello',3]) => "[1,'hello',3] properly suceeds"; - ok $positioned_obj->tuple_with_union([1,'hello',3,1]) + ok $obj->tuple_with_union([1,'hello',3,1]) => "[1,'hello',3,1] properly suceeds"; - ok $positioned_obj->tuple_with_union([1,'hello',3,4]) + ok $obj->tuple_with_union([1,'hello',3,4]) => "[1,'hello',3,4] properly suceeds"; - ok $positioned_obj->tuple_with_union([1,'hello',3,4,5]) + ok $obj->tuple_with_union([1,'hello',3,4,5]) => "[1,'hello',3,4,5] properly suceeds"; throws_ok sub { - $positioned_obj->tuple_with_union([1,'hello',3,4,5,6]); + $obj->tuple_with_union([1,'hello',3,4,5,6]); }, qr/Too Many arguments for the available type constraints/ => "[1,'hello',3,4,5,6] properly fails"; throws_ok sub { - $positioned_obj->tuple_with_union([1,2,'world']); + $obj->tuple_with_union([1,2,'world']); }, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails"; throws_ok sub { - $positioned_obj->tuple_with_union(['hello1',2,3]); + $obj->tuple_with_union(['hello1',2,3]); }, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails"; throws_ok sub { - $positioned_obj->tuple_with_union(['hello2',2,'world']); + $obj->tuple_with_union(['hello2',2,'world']); }, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails"; } diff --git a/t/02-constraints.t b/t/02-constraints.t index 5bceb08..86c4e6c 100644 --- a/t/02-constraints.t +++ b/t/02-constraints.t @@ -10,21 +10,23 @@ BEGIN { use Moose; use MooseX::Types::Structured qw(Tuple Dict Optional); + use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe); + use MooseX::Types -declare => [qw(MyString)]; use Moose::Util::TypeConstraints; - subtype 'MyString', + subtype MyString, as 'Str', where { $_=~m/abc/}; - has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']); - has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']); - has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']); - has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']); - has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']); - has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]); - has 'optional_tuple' => (is=>'rw', isa=>Tuple['Int', 'Int', Optional['Int']] ); - has 'optional_dict' => (is=>'rw', isa=>Dict[key1=>'Int', Optional[key2=>'Int']] ); - has 'dict_with_tuple_with_union' => (is=>'rw', isa=>Dict[key1=>'Str|Object', key2=>Tuple['Int','Str|Object']] ); + has 'tuple' => (is=>'rw', isa=>Tuple[Int, Str, MyString]); + has 'dict' => (is=>'rw', isa=>Dict[name=>Str, age=>Int]); + has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>Str, age=>Maybe[Int]]); + has 'tuple_with_param' => (is=>'rw', isa=>Tuple[Int, Str, ArrayRef[Int]]); + has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple[Int, Str, Maybe[Int]]); + has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>Str, key2=>Tuple[Int,Str]]); + has 'optional_tuple' => (is=>'rw', isa=>Tuple[Int, Int, Optional[Int]] ); + has 'optional_dict' => (is=>'rw', isa=>Dict[key1=>Int, Optional[key2=>Int]] ); + has 'dict_with_tuple_with_union' => (is=>'rw', isa=>Dict[key1=>Str|Object, key2=>Tuple[Int,Str|Object]] ); has 'crazy' => ( is=>'rw', @@ -32,15 +34,15 @@ BEGIN { ## First ArrayRef Arg is the required type constraints for the top ## level Tuple. [ - 'Int', - 'MyString', + Int, + MyString, ## The third required element is a Dict type constraint, which ## itself has two required keys and a third optional key. - Dict[name=>'Str',age=>'Int', Optional[visits=>'Int']], + Dict[name=>Str,age=>Int, Optional[visits=>Int]], Optional[ - 'Int', + Int, ## This Tuple has one required type constraint and two optional. - Tuple['Int', Optional['Int','HashRef']], + Tuple[Int, Optional[Int,HashRef]], ], ], ); diff --git a/t/optional.t b/t/optional.t new file mode 100755 index 0000000..4bfa0fc --- /dev/null +++ b/t/optional.t @@ -0,0 +1,209 @@ +BEGIN { + use strict; + use warnings; + use Test::More tests=>16; + use Test::Exception; + use Data::Dump qw/dump/; + + use_ok 'Moose::Util::TypeConstraints'; +} + +Moose::Util::TypeConstraints::register_type_constraint( + Moose::Meta::TypeConstraint::Parameterizable->new( + name => 'Optional', + package_defined_in => __PACKAGE__, + parent => find_type_constraint('Item'), + constraint => sub { 1 }, + constraint_generator => sub { + my $type_parameter = shift; + my $check = $type_parameter->_compiled_type_constraint; + return sub { + use Data::Dump qw/dump/; + warn dump @_; + return 1 if not(defined($_)) || $check->($_); + return; + } + } + ) +); + +ok Moose::Util::TypeConstraints::find_type_constraint('Optional') + => 'Found the Optional Type'; + +{ + package Test::MooseX::Types::Optional; + use Moose; + + has 'Maybe_Int' => (is=>'rw', isa=>'Maybe[Int]'); + has 'Maybe_ArrayRef' => (is=>'rw', isa=>'Maybe[ArrayRef]'); + has 'Maybe_HashRef' => (is=>'rw', isa=>'Maybe[HashRef]'); + has 'Maybe_ArrayRefInt' => (is=>'rw', isa=>'Maybe[ArrayRef[Int]]'); + has 'Maybe_HashRefInt' => (is=>'rw', isa=>'Maybe[HashRef[Int]]'); +} + +ok my $obj = Test::MooseX::Types::Optional->new + => 'Create good test object'; + +## Maybe[Int] + +ok my $Maybe_Int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]') + => 'made TC Maybe[Int]'; + +ok $Maybe_Int->check(1) + => 'passed (1)'; + + ok $obj->Maybe_Int(1) + => 'assigned (1)'; + +ok $Maybe_Int->check() + => 'passed ()'; + + ok $obj->Maybe_Int() + => 'assigned ()'; + +ok $Maybe_Int->check(0) + => 'passed (0)'; + + ok defined $obj->Maybe_Int(0) + => 'assigned (0)'; + +ok $Maybe_Int->check(undef) + => 'passed (undef)'; + + ok sub {$obj->Maybe_Int(undef); 1}->() + => 'assigned (undef)'; + +ok !$Maybe_Int->check("") + => 'failed ("")'; + + throws_ok sub { $obj->Maybe_Int("") }, + qr/Attribute \(Maybe_Int\) does not pass the type constraint/ + => 'failed assigned ("")'; + +ok !$Maybe_Int->check("a") + => 'failed ("a")'; + + throws_ok sub { $obj->Maybe_Int("a") }, + qr/Attribute \(Maybe_Int\) does not pass the type constraint/ + => 'failed assigned ("a")'; + +__END__ + + +ok $obj->Maybe_Int(undef) + => 'passed 1'; + +ok $obj->Maybe_Int(); + +ok $obj->Maybe_Int('') + => 'passed 1'; + +ok $obj->Maybe_Int('a') + => 'passed 1'; + + + + +ok $obj->tuple([1,'hello',3]) + => "[1,'hello',3] properly suceeds"; + +throws_ok sub { + $obj->tuple([1,2,'world']); +}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails"; + +throws_ok sub { + $obj->tuple(['hello1',2,3]); +}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails"; + +throws_ok sub { + $obj->tuple(['hello2',2,'world']); +}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails"; + + +## Test tuple_with_parameterized (Tuple[Int,Str,Int,ArrayRef[Int]]) + +ok $obj->tuple_with_parameterized([1,'hello',3,[1,2,3]]) + => "[1,'hello',3,[1,2,3]] properly suceeds"; + +throws_ok sub { + $obj->tuple_with_parameterized([1,2,'world']); +}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails"; + +throws_ok sub { + $obj->tuple_with_parameterized(['hello1',2,3]); +}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails"; + +throws_ok sub { + $obj->tuple_with_parameterized(['hello2',2,'world']); +}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails"; + +throws_ok sub { + $obj->tuple_with_parameterized([1,'hello',3,[1,2,'world']]); +}, qr/Validation failed for 'ArrayRef\[Int\]'/ => "[1,'hello',3,[1,2,'world']] properly fails"; + + +## Test tuple_with_optional (Tuple[Int,Str,Int,Optional[Int,Int]]) + +ok $obj->tuple_with_optional([1,'hello',3]) + => "[1,'hello',3] properly suceeds"; + +ok $obj->tuple_with_optional([1,'hello',3,1]) + => "[1,'hello',3,1] properly suceeds"; + +ok $obj->tuple_with_optional([1,'hello',3,4]) + => "[1,'hello',3,4] properly suceeds"; + +ok $obj->tuple_with_optional([1,'hello',3,4,5]) + => "[1,'hello',3,4,5] properly suceeds"; + +throws_ok sub { + $obj->tuple_with_optional([1,'hello',3,4,5,6]); +}, qr/Too Many arguments for the available type constraints/ => "[1,'hello',3,4,5,6] properly fails"; + +throws_ok sub { + $obj->tuple_with_optional([1,2,'world']); +}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails"; + +throws_ok sub { + $obj->tuple_with_optional(['hello1',2,3]); +}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails"; + +throws_ok sub { + $obj->tuple_with_optional(['hello2',2,'world']); +}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails"; + +## tuple_with_union Tuple[Int,Str,Int|Object,Optional[Int|Object,Int]] + +SKIP: { + + skip "Unions not supported for string parsed type constraints" => 8; + + ok $obj->tuple_with_union([1,'hello',3]) + => "[1,'hello',3] properly suceeds"; + + ok $obj->tuple_with_union([1,'hello',3,1]) + => "[1,'hello',3,1] properly suceeds"; + + ok $obj->tuple_with_union([1,'hello',3,4]) + => "[1,'hello',3,4] properly suceeds"; + + ok $obj->tuple_with_union([1,'hello',3,4,5]) + => "[1,'hello',3,4,5] properly suceeds"; + + throws_ok sub { + $obj->tuple_with_union([1,'hello',3,4,5,6]); + }, qr/Too Many arguments for the available type constraints/ => "[1,'hello',3,4,5,6] properly fails"; + + throws_ok sub { + $obj->tuple_with_union([1,2,'world']); + }, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails"; + + throws_ok sub { + $obj->tuple_with_union(['hello1',2,3]); + }, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails"; + + throws_ok sub { + $obj->tuple_with_union(['hello2',2,'world']); + }, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails"; +} +