X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F001_mouse%2F039-subtype.t;h=50b7bf9c1490eda2abfc1df6db12b4b5ea7afc66;hb=007481ba62fece04677f0a81f964a58679262e4e;hp=755c40514101104e497176b18e63c72962797ba6;hpb=920139b3efca66d2caeeef306c97fa0da62c6b73;p=gitmo%2FMouse.git diff --git a/t/001_mouse/039-subtype.t b/t/001_mouse/039-subtype.t index 755c405..50b7bf9 100644 --- a/t/001_mouse/039-subtype.t +++ b/t/001_mouse/039-subtype.t @@ -1,7 +1,7 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 7; +use Test::More tests => 11; use Test::Exception; use Mouse::Util::TypeConstraints; @@ -16,10 +16,16 @@ do { => where { length $_ } => message { "The string is empty!" }; + subtype 'MyClass' + => as 'Object' + => where { $_->isa(__PACKAGE__) }; + has name => ( is => 'ro', isa => 'NonemptyStr', ); + + }; ok(My::Class->new(name => 'foo')); @@ -35,3 +41,10 @@ ok $st->check('Foo'); ok!$st->check(undef); ok!$st->check(''); +lives_and{ + my $tc = find_type_constraint('MyClass'); + ok $tc->check(My::Class->new()); + ok!$tc->check('My::Class'); + ok!$tc->check([]); + ok!$tc->check(undef); +};