X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F040_type_constraints%2F001_util_type_constraints.t;h=cf4e7e5f656569da2a035ca97b6bd62202bbd35c;hb=d03bd989b97597428b460d7f9a021e2931893fa0;hp=20ceae6de3789058fcd83dfb410ef9dbc579ffd1;hpb=9758af8af0c362eebb20cf2501eac3f734d7fef3;p=gitmo%2FMoose.git diff --git a/t/040_type_constraints/001_util_type_constraints.t b/t/040_type_constraints/001_util_type_constraints.t index 20ceae6..cf4e7e5 100644 --- a/t/040_type_constraints/001_util_type_constraints.t +++ b/t/040_type_constraints/001_util_type_constraints.t @@ -3,29 +3,28 @@ use strict; use warnings; -use Test::More tests => 44; +use Test::More tests => 85; use Test::Exception; use Scalar::Util (); -BEGIN { - use_ok('Moose::Util::TypeConstraints'); -} +use Moose::Util::TypeConstraints; + type Number => where { Scalar::Util::looks_like_number($_) }; -type String +type String => where { !ref($_) && !Number($_) } => message { "This is not a string ($_)" }; -subtype Natural - => as Number - => where { $_ > 0 }; +subtype Natural + => as Number + => where { $_ > 0 }; + +subtype NaturalLessThanTen + => as Natural + => where { $_ < 10 } + => message { "The number '$_' is not less than 10" }; -subtype NaturalLessThanTen - => as Natural - => where { $_ < 10 } - => message { "The number '$_' is not less than 10" }; - Moose::Util::TypeConstraints->export_type_constraints_as_functions(); ok(Number(5), '... this is a Num'); @@ -46,10 +45,10 @@ ok(NaturalLessThanTen(5), '... this is a NaturalLessThanTen'); is(NaturalLessThanTen(12), undef, '... this is not a NaturalLessThanTen'); is(NaturalLessThanTen(-5), undef, '... this is not a NaturalLessThanTen'); is(NaturalLessThanTen('Foo'), undef, '... this is not a NaturalLessThanTen'); - -# anon sub-typing - -my $negative = subtype Number => where { $_ < 0 }; + +# anon sub-typing + +my $negative = subtype Number => where { $_ < 0 }; ok(defined $negative, '... got a value back from negative'); isa_ok($negative, 'Moose::Meta::TypeConstraint'); @@ -60,6 +59,23 @@ is($negative->check('Foo'), undef, '... this is not a negative number'); ok($negative->is_subtype_of('Number'), '... $negative is a subtype of Number'); ok(!$negative->is_subtype_of('String'), '... $negative is not a subtype of String'); +my $negative2 = subtype Number => where { $_ < 0 } => message {"$_ is not a negative number"}; + +ok(defined $negative2, '... got a value back from negative'); +isa_ok($negative2, 'Moose::Meta::TypeConstraint'); + +ok($negative2->check(-5), '... this is a negative number'); +ok(!defined($negative2->check(5)), '... this is not a negative number'); +is($negative2->check('Foo'), undef, '... this is not a negative number'); + +ok($negative2->is_subtype_of('Number'), '... $negative2 is a subtype of Number'); +ok(!$negative2->is_subtype_of('String'), '... $negative is not a subtype of String'); + +ok($negative2->has_message, '... it has a message'); +is($negative2->validate(2), + '2 is not a negative number', + '... validated unsuccessfully (got error)'); + # check some meta-details my $natural_less_than_ten = find_type_constraint('NaturalLessThanTen'); @@ -73,8 +89,8 @@ ok($natural_less_than_ten->has_message, '... it has a message'); ok(!defined($natural_less_than_ten->validate(5)), '... validated successfully (no error)'); -is($natural_less_than_ten->validate(15), - "The number '15' is not less than 10", +is($natural_less_than_ten->validate(15), + "The number '15' is not less than 10", '... validated unsuccessfully (got error)'); my $natural = find_type_constraint('Natural'); @@ -87,8 +103,8 @@ 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 with value -5", +is($natural->validate(-5), + "Validation failed for 'Natural' failed with value -5", '... validated unsuccessfully (got error)'); my $string = find_type_constraint('String'); @@ -98,8 +114,8 @@ ok($string->has_message, '... it does have a message'); ok(!defined($string->validate("Five")), '... validated successfully (no error)'); -is($string->validate(5), -"This is not a string (5)", +is($string->validate(5), +"This is not a string (5)", '... validated unsuccessfully (got error)'); lives_ok { Moose::Meta::Attribute->new('bob', isa => 'Spong') } @@ -118,3 +134,94 @@ throws_ok {$r->add_type_constraint()} qr/not a valid type constraint/, '->add_ty throws_ok {$r->add_type_constraint('foo')} qr/not a valid type constraint/, '->add_type_constraint("foo") throws'; throws_ok {$r->add_type_constraint(bless {}, 'SomeClass')} qr/not a valid type constraint/, '->add_type_constraint(SomeClass->new) throws'; +# Test some specific things that in the past did not work, +# specifically weird variations on anon subtypes. + +{ + my $subtype = subtype as 'Str'; + isa_ok( $subtype, 'Moose::Meta::TypeConstraint', 'got an anon subtype' ); + is( $subtype->parent->name, 'Str', 'parent is Str' ); + # This test sucks but is the best we can do + is( $subtype->constraint->(), 1, + 'subtype has the null constraint' ); + ok( ! $subtype->has_message, 'subtype has no message' ); +} + +{ + my $subtype = subtype as 'ArrayRef[Num|Str]'; + isa_ok( $subtype, 'Moose::Meta::TypeConstraint', 'got an anon subtype' ); + is( $subtype->parent->name, 'ArrayRef[Num|Str]', 'parent is ArrayRef[Num|Str]' ); + ok( ! $subtype->has_message, 'subtype has no message' ); +} + +{ + my $subtype = subtype 'ArrayRef[Num|Str]' => message { 'foo' }; + isa_ok( $subtype, 'Moose::Meta::TypeConstraint', 'got an anon subtype' ); + is( $subtype->parent->name, 'ArrayRef[Num|Str]', 'parent is ArrayRef[Num|Str]' ); + ok( $subtype->has_message, 'subtype does have a message' ); +} + +# alternative sugar-less calling style which is documented as legit: +{ + my $subtype = subtype( 'MyStr', { as => 'Str' } ); + isa_ok( $subtype, 'Moose::Meta::TypeConstraint', 'got a subtype' ); + is( $subtype->name, 'MyStr', 'name is MyStr' ); + is( $subtype->parent->name, 'Str', 'parent is Str' ); +} + +{ + my $subtype = subtype( { as => 'Str' } ); + isa_ok( $subtype, 'Moose::Meta::TypeConstraint', 'got a subtype' ); + is( $subtype->name, '__ANON__', 'name is __ANON__' ); + is( $subtype->parent->name, 'Str', 'parent is Str' ); +} + +{ + my $subtype = subtype( { as => 'Str', where => sub { /X/ } } ); + isa_ok( $subtype, 'Moose::Meta::TypeConstraint', 'got a subtype' ); + is( $subtype->name, '__ANON__', 'name is __ANON__' ); + is( $subtype->parent->name, 'Str', 'parent is Str' ); + ok( $subtype->check('FooX'), 'constraint accepts FooX' ); + ok( ! $subtype->check('Foo'), 'constraint reject Foo' ); +} + +{ + throws_ok { subtype 'Foo' } qr/cannot consist solely of a name/, + 'Cannot call subtype with a single string argument'; +} + +# Back-compat for being called without sugar. Previously, calling with +# sugar was indistinguishable from calling directly. + +{ + my $type = type( 'Number2', sub { Scalar::Util::looks_like_number($_) } ); + + ok( $type->check(5), '... this is a Num' ); + ok( ! $type->check('Foo'), '... this is not a Num' ); +} + +{ + # anon subtype + my $subtype = subtype( 'Number2', sub { $_ > 0 } ); + + ok( $subtype->check(5), '... this is a Natural'); + ok( ! $subtype->check(-5), '... this is not a Natural'); + ok( ! $subtype->check('Foo'), '... this is not a Natural'); +} + +{ + my $subtype = subtype( 'Natural2', 'Number2', sub { $_ > 0 } ); + + ok( $subtype->check(5), '... this is a Natural'); + ok( ! $subtype->check(-5), '... this is not a Natural'); + ok( ! $subtype->check('Foo'), '... this is not a Natural'); +} + +{ + my $subtype = subtype( 'Natural3', 'Number2' ); + + ok( $subtype->check(5), '... this is a Natural'); + ok( $subtype->check(-5), '... this is a Natural'); + ok( ! $subtype->check('Foo'), '... this is not a Natural'); +} +