X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F040_type_constraints%2F024_role_type_constraint.t;h=6273f5405d8cf90b4f4be2ebc98852b16e056ac7;hb=7543127e02af5649f377d0d4246be1188002f91f;hp=ee13ebefbc65c86c89fcad509f37694acd3d4e18;hpb=620db0454d31341c981eb9061132d4f3a08a7310;p=gitmo%2FMoose.git diff --git a/t/040_type_constraints/024_role_type_constraint.t b/t/040_type_constraints/024_role_type_constraint.t index ee13ebe..6273f54 100644 --- a/t/040_type_constraints/024_role_type_constraint.t +++ b/t/040_type_constraints/024_role_type_constraint.t @@ -22,9 +22,16 @@ BEGIN { with qw(Bar Gorch); + package FooC; + use Moose; + with qw(Foo); + + package BarC; + use Moose; + with qw(Bar); + } -lives_ok { role_type 'Beep' } 'role_type keywork works'; lives_ok { role_type('Boop', message { "${_} is not a Boop" }) } 'role_type keywork works with message'; @@ -38,14 +45,16 @@ ok( $type->is_subtype_of("Bar"), "subtype of bar" ); ok( $type->is_subtype_of("Object"), "subtype of Object" ); -ok( find_type_constraint("Bar")->check(Foo->new), "Foo passes Bar" ); -ok( find_type_constraint("Bar")->check(Bar->new), "Bar passes Bar" ); -ok( !find_type_constraint("Gorch")->check(Bar->new), "but Bar doesn't pass Gorch"); +ok( !$type->is_subtype_of("ThisTypeDoesNotExist"), "not subtype of unknown type name" ); +ok( !$type->is_a_type_of("ThisTypeDoesNotExist"), "not type of unknown type name" ); + +ok( find_type_constraint("Bar")->check(FooC->new), "Foo passes Bar" ); +ok( find_type_constraint("Bar")->check(BarC->new), "Bar passes Bar" ); +ok( !find_type_constraint("Gorch")->check(BarC->new), "but Bar doesn't pass Gorch"); -ok( find_type_constraint("Beep")->check( bless {} => 'Beep' ), "Beep passes Beep" ); my $boop = find_type_constraint("Boop"); ok( $boop->has_message, 'Boop has a message'); -my $error = $boop->get_message(Foo->new); +my $error = $boop->get_message(FooC->new); like( $error, qr/is not a Boop/, 'boop gives correct error message');