X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=t%2F025-more-isa.t;h=3e18e967cc5a0cd22adc8c8dbd033a37cf81a54d;hp=e68e0ec7f4cc5222ad323eb3580cd35eb6e54fc3;hb=ff6870694bb440c13826e0f0fa25e760247fd24e;hpb=fb706f5c1e60ddafe873717be7209066d47b8998 diff --git a/t/025-more-isa.t b/t/025-more-isa.t old mode 100644 new mode 100755 index e68e0ec..3e18e96 --- a/t/025-more-isa.t +++ b/t/025-more-isa.t @@ -1,7 +1,7 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 10; +use Test::More tests => 34; use Test::Exception; do { @@ -12,6 +12,9 @@ do { is => 'rw', isa => 'Test::Builder', ); + + package Test::Builder::Subclass; + our @ISA = qw(Test::Builder); }; can_ok(Class => 'tb'); @@ -21,6 +24,13 @@ lives_ok { }; lives_ok { + # Test::Builder was a bizarre choice, because it's a singleton. Because of + # that calling new on T:B:S won't work. Blessing directly -- rjbs, + # 2008-12-04 + Class->new(tb => (bless {} => 'Test::Builder::Subclass')); +}; + +lives_ok { my $class = Class->new; $class->tb(Test::Builder->new); isa_ok($class->tb, 'Test::Builder'); @@ -44,6 +54,7 @@ do { use Mouse; has oops => ( + is => 'bare', isa => 'Int', default => "yikes", ); @@ -57,3 +68,114 @@ lives_ok { Other->new(oops => 10); }; +# ClassName coverage tests + +do { + package A; + our @VERSION; + + package B; + our $VERSION = 1; + + package C; + our %ISA; + + package D; + our @ISA = 'Mouse::Object'; + + package E; + sub foo {} + + package F; + + package G::H; + sub bar {} + + package I; + our $NOT_CODE = 1; +}; + +do { + package ClassNameTests; + use Mouse; + + has class => ( + is => 'rw', + isa => 'ClassName', + ); +}; + +for ('B', 'D'..'E', 'G::H') { + lives_ok { + ClassNameTests->new(class => $_); + }; + + lives_ok { + my $obj = ClassNameTests->new; + $obj->class($_); + }; +} + +throws_ok { + ClassNameTests->new(class => 'A'); +} qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/; + +throws_ok { + my $obj = ClassNameTests->new; + $obj->class('A'); +} qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/; + +throws_ok { + ClassNameTests->new(class => 'C'); +} qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value C/; + +throws_ok { + my $obj = ClassNameTests->new; + $obj->class('C'); +} qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value C/; + +for ('F', 'G', 'I', 'Z') { + throws_ok { + ClassNameTests->new(class => $_); + } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/; + + throws_ok { + my $obj = ClassNameTests->new; + $obj->class($_); + } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/; +}; + + +# Check that Roles can be used in 'isa' and they are constrained with +# 'does' +do { + package SausageRole; + use Mouse::Role; + + package DoesSausage; + use Mouse; + with 'SausageRole'; + + package HasSausage; + use Mouse; + + has sausage => + (isa => 'SausageRole', + is => 'rw'); + +}; + +my $hs; +lives_ok { + $hs = HasSausage->new(sausage => DoesSausage->new); +}; +lives_ok { + $hs->sausage(DoesSausage->new); +}; +throws_ok { + HasSausage->new(sausage => Class->new); +} qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' failed with value Class=/; +throws_ok { + $hs->sausage(Class->new); +} qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' failed with value Class=/; +