From: Stevan Little Date: Fri, 21 Apr 2006 20:07:14 +0000 (+0000) Subject: unions X-Git-Tag: 0_05~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=451c82489113d15c971c0d4a9867c2005649dec3;p=gitmo%2FMoose.git unions --- diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm index 61c2b62..8d3d1c0 100644 --- a/lib/Moose/Meta/TypeConstraint.pm +++ b/lib/Moose/Meta/TypeConstraint.pm @@ -8,7 +8,7 @@ use metaclass; use Sub::Name 'subname'; use Carp 'confess'; -our $VERSION = '0.02'; +our $VERSION = '0.03'; __PACKAGE__->meta->add_attribute('name' => (reader => 'name' )); __PACKAGE__->meta->add_attribute('parent' => (reader => 'parent' )); @@ -34,7 +34,7 @@ sub new { return $self; } -sub compile_type_constraint () { +sub compile_type_constraint { my $self = shift; my $check = $self->constraint; (defined $check) @@ -72,11 +72,61 @@ sub validate { return $self->message->($value); } else { - return "Validation failed for '" . $self->name . "' failed."; + return "Validation failed for '" . $self->name . "' failed"; } } } +sub union { + my ($class, @type_constraints) = @_; + return Moose::Meta::TypeConstraint::Union->new( + type_constraints => \@type_constraints + ); +} + +package Moose::Meta::TypeConstraint::Union; + +use strict; +use warnings; +use metaclass; + +our $VERSION = '0.01'; + +__PACKAGE__->meta->add_attribute('type_constraints' => ( + accessor => 'type_constraints', + default => sub { [] } +)); + +sub new { + my $class = shift; + my $self = $class->meta->new_object(@_); + return $self; +} + +sub name { join ' | ' => map { $_->name } @{$_[0]->type_constraints} } + +sub check { + my $self = shift; + my $value = shift; + foreach my $type (@{$self->type_constraints}) { + return 1 if $type->check($value); + } + return undef; +} + +sub validate { + my $self = shift; + my $value = shift; + my $message; + foreach my $type (@{$self->type_constraints}) { + my $err = $type->validate($value); + return unless defined $err; + $message .= ($message ? ' and ' : '') . $err + if defined $err; + } + return ($message . ' in (' . $self->name . ')') ; +} + 1; __END__ @@ -136,6 +186,12 @@ the C will be used to construct a custom error message. =back +=over 4 + +=item B + +=back + =head1 BUGS All complex software has bugs lurking in it, and this module is no diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 4a9e4aa..3d6d7ba 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -120,12 +120,8 @@ subtype 'Num' => as 'Value' => where { Scalar::Util::looks_like_number($_) }; subtype 'Int' => as 'Num' => where { "$_" =~ /^[0-9]+$/ }; subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' }; - -subtype 'CollectionRef' => as 'Ref' => where { ref($_) eq 'ARRAY' || ref($_) eq 'HASH' }; - -subtype 'ArrayRef' => as 'CollectionRef' => where { ref($_) eq 'ARRAY' }; -subtype 'HashRef' => as 'CollectionRef' => where { ref($_) eq 'HASH' }; - +subtype 'ArrayRef' => as 'Ref' => where { ref($_) eq 'ARRAY' }; +subtype 'HashRef' => as 'Ref' => where { ref($_) eq 'HASH' }; subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' }; subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' }; @@ -195,9 +191,8 @@ could probably use some work, but it works for me at the moment. Str Ref ScalarRef - CollectionRef - ArrayRef - HashRef + ArrayRef + HashRef CodeRef RegexpRef Object diff --git a/t/050_util_type_constraints.t b/t/050_util_type_constraints.t index 5d9e6d1..6316806 100644 --- a/t/050_util_type_constraints.t +++ b/t/050_util_type_constraints.t @@ -72,7 +72,7 @@ ok(!$natural->has_message, '... it does not have a message'); ok(!defined($natural->validate(5)), '... validated successfully (no error)'); is($natural->validate(-5), - "Validation failed for 'Natural' failed.", + "Validation failed for 'Natural' failed", '... validated unsuccessfully (got error)'); diff --git a/t/052_util_std_type_constraints.t b/t/052_util_std_type_constraints.t index e340b63..4a97f6c 100644 --- a/t/052_util_std_type_constraints.t +++ b/t/052_util_std_type_constraints.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 205; +use Test::More tests => 194; use Test::Exception; use Scalar::Util (); @@ -153,18 +153,6 @@ ok(!defined ScalarRef(qr/../), '... ScalarRef rejects anything which i ok(!defined ScalarRef(bless {}, 'Foo'), '... ScalarRef rejects anything which is not a ScalarRef'); ok(!defined ScalarRef(undef), '... ScalarRef rejects anything which is not a ScalarRef'); -ok(!defined CollectionRef(0), '... CollectionRef rejects anything which is not a HASH or ARRAY'); -ok(!defined CollectionRef(100), '... CollectionRef rejects anything which is not a HASH or ARRAY'); -ok(!defined CollectionRef(''), '... CollectionRef rejects anything which is not a HASH or ARRAY'); -ok(!defined CollectionRef('Foo'), '... CollectionRef rejects anything which is not a HASH or ARRAY'); -ok(defined CollectionRef([]), '... CollectionRef accepts anything which is not a HASH or ARRAY'); -ok(defined CollectionRef({}), '... CollectionRef rejects anything which is not a HASH or ARRAY'); -ok(!defined CollectionRef(sub {}), '... CollectionRef rejects anything which is not a HASH or ARRAY'); -ok(!defined CollectionRef($SCALAR_REF), '... CollectionRef rejects anything which is not a HASH or ARRAY'); -ok(!defined CollectionRef(qr/../), '... CollectionRef rejects anything which is not a HASH or ARRAY'); -ok(!defined CollectionRef(bless {}, 'Foo'), '... CollectionRef rejects anything which is not a HASH or ARRAY'); -ok(!defined CollectionRef(undef), '... CollectionRef rejects anything which is not a HASH or ARRAY'); - ok(!defined ArrayRef(0), '... ArrayRef rejects anything which is not a ArrayRef'); ok(!defined ArrayRef(100), '... ArrayRef rejects anything which is not a ArrayRef'); ok(!defined ArrayRef(''), '... ArrayRef rejects anything which is not a ArrayRef'); diff --git a/t/053_util_find_type_constraint.t b/t/053_util_find_type_constraint.t index 9d77f39..b492250 100644 --- a/t/053_util_find_type_constraint.t +++ b/t/053_util_find_type_constraint.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 15; +use Test::More tests => 18; use Test::Exception; BEGIN { @@ -12,19 +12,22 @@ BEGIN { foreach my $type_name (qw( Any + Item Bool - Value - Int - Str - Ref - ScalarRef - CollectionRef + Undef + Defined + Value + Num + Int + Str + Ref + ScalarRef ArrayRef HashRef - CodeRef - RegexpRef - Object - Role + CodeRef + RegexpRef + Object + Role )) { is(find_type_constraint($type_name)->name, $type_name, diff --git a/t/057_union_types.t b/t/057_union_types.t new file mode 100644 index 0000000..556d3e7 --- /dev/null +++ b/t/057_union_types.t @@ -0,0 +1,61 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 27; +use Test::Exception; + +BEGIN { + use_ok('Moose::Util::TypeConstraints'); +} + +my $Str = find_type_constraint('Str'); +isa_ok($Str, 'Moose::Meta::TypeConstraint'); + +my $Undef = find_type_constraint('Undef'); +isa_ok($Undef, 'Moose::Meta::TypeConstraint'); + +ok(!$Str->check(undef), '... Str cannot accept an Undef value'); +ok($Str->check('String'), '... Str can accept an String value'); +ok(!$Undef->check('String'), '... Undef cannot accept an Str value'); +ok($Undef->check(undef), '... Undef can accept an Undef value'); + +my $Str_or_Undef = Moose::Meta::TypeConstraint->union($Str, $Undef); +isa_ok($Str_or_Undef, 'Moose::Meta::TypeConstraint::Union'); + +ok($Str_or_Undef->check(undef), '... (Str | Undef) can accept an Undef value'); +ok($Str_or_Undef->check('String'), '... (Str | Undef) can accept a String value'); + +# another .... + +my $ArrayRef = find_type_constraint('ArrayRef'); +isa_ok($ArrayRef, 'Moose::Meta::TypeConstraint'); + +my $HashRef = find_type_constraint('HashRef'); +isa_ok($HashRef, 'Moose::Meta::TypeConstraint'); + +ok($ArrayRef->check([]), '... ArrayRef can accept an [] value'); +ok(!$ArrayRef->check({}), '... ArrayRef cannot accept an {} value'); +ok($HashRef->check({}), '... HashRef can accept an {} value'); +ok(!$HashRef->check([]), '... HashRef cannot accept an [] value'); + +my $HashOrArray = Moose::Meta::TypeConstraint->union($ArrayRef, $HashRef); +isa_ok($HashOrArray, 'Moose::Meta::TypeConstraint::Union'); + +ok($HashOrArray->check([]), '... (ArrayRef | HashRef) can accept []'); +ok($HashOrArray->check({}), '... (ArrayRef | HashRef) can accept {}'); + +ok(!$HashOrArray->check(\(my $var1)), '... (ArrayRef | HashRef) cannot accept scalar refs'); +ok(!$HashOrArray->check(sub {}), '... (ArrayRef | HashRef) cannot accept code refs'); +ok(!$HashOrArray->check(50), '... (ArrayRef | HashRef) cannot accept Numbers'); + +diag $HashOrArray->validate([]); + +ok(!defined($HashOrArray->validate([])), '... (ArrayRef | HashRef) can accept []'); +ok(!defined($HashOrArray->validate({})), '... (ArrayRef | HashRef) can accept {}'); + +is($HashOrArray->validate(\(my $var2)), 'Validation failed for \'ArrayRef\' failed and Validation failed for \'HashRef\' failed in (ArrayRef | HashRef)', '... (ArrayRef | HashRef) cannot accept scalar refs'); +is($HashOrArray->validate(sub {}), 'Validation failed for \'ArrayRef\' failed and Validation failed for \'HashRef\' failed in (ArrayRef | HashRef)', '... (ArrayRef | HashRef) cannot accept code refs'); +is($HashOrArray->validate(50), 'Validation failed for \'ArrayRef\' failed and Validation failed for \'HashRef\' failed in (ArrayRef | HashRef)', '... (ArrayRef | HashRef) cannot accept Numbers'); +