X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F025-more-isa.t;h=6e621a7e3a1689cb5a202de6b83a60d232e3c32a;hb=c9313657717f78bd96f0325c6aa1c93d0b0d41a5;hp=f11dc2581a815522cb84937d8a67889cc963d241;hpb=7ecc21230bd017cdb82e6163b4053ac286ea1273;p=gitmo%2FMouse.git

diff --git a/t/025-more-isa.t b/t/025-more-isa.t
old mode 100644
new mode 100755
index f11dc25..6e621a7
--- 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 => 23;
+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",
     );
@@ -61,20 +72,27 @@ lives_ok {
 
 do {
     package A;
-    our $VERSION = 1;
+    our @VERSION;
 
-    package B;
-    our @ISA = 'Mouse::Object';
+    package Bx; # 'B' conflicts the B module
+    our $VERSION = 1;
 
     package C;
-    sub foo {}
+    our %ISA;
 
-    package D::Child;
-    sub bar {}
+    package D;
+    our @ISA = 'Mouse::Object';
 
     package E;
+    sub foo {}
 
     package F;
+
+    package G::H;
+    sub bar {}
+
+    package I;
+    no warnings 'once'; # work around 5.6.2
     our $NOT_CODE = 1;
 };
 
@@ -88,7 +106,7 @@ do {
     );
 };
 
-for ('A'..'C', 'D::Child') {
+for ('Bx', 'D'..'E', 'G::H') {
     lives_ok {
         ClassNameTests->new(class => $_);
     };
@@ -99,7 +117,25 @@ for ('A'..'C', 'D::Child') {
     };
 }
 
-for ('E'..'F', 'NonExistentClass') {
+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 $_/;
@@ -110,3 +146,37 @@ for ('E'..'F', 'NonExistentClass') {
     } 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=/;
+