Correct error message to include 'Maybe' as implemented parametric type.
[gitmo/Mouse.git] / t / 025-more-isa.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 30;
5 use Test::Exception;
6
7 do {
8     package Class;
9     use Mouse;
10
11     has tb => (
12         is  => 'rw',
13         isa => 'Test::Builder',
14     );
15
16     package Test::Builder::Subclass;
17     our @ISA = qw(Test::Builder);
18 };
19
20 can_ok(Class => 'tb');
21
22 lives_ok {
23     Class->new(tb => Test::Builder->new);
24 };
25
26 lives_ok {
27     # Test::Builder was a bizarre choice, because it's a singleton.  Because of
28     # that calling new on T:B:S won't work.  Blessing directly -- rjbs,
29     # 2008-12-04
30     Class->new(tb => (bless {} => 'Test::Builder::Subclass'));
31 };
32
33 lives_ok {
34     my $class = Class->new;
35     $class->tb(Test::Builder->new);
36     isa_ok($class->tb, 'Test::Builder');
37 };
38
39 throws_ok {
40     Class->new(tb => 3);
41 } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value 3/;
42
43 throws_ok {
44     my $class = Class->new;
45     $class->tb(3);
46 } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value 3/;
47
48 throws_ok {
49     Class->new(tb => Class->new);
50 } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value Class=HASH\(\w+\)/;
51
52 do {
53     package Other;
54     use Mouse;
55
56     has oops => (
57         isa     => 'Int',
58         default => "yikes",
59     );
60 };
61
62 throws_ok {
63     Other->new;
64 } qr/Attribute \(oops\) does not pass the type constraint because: Validation failed for 'Int' failed with value yikes/;
65
66 lives_ok {
67     Other->new(oops => 10);
68 };
69
70 # ClassName coverage tests
71
72 do {
73     package A;
74     our @VERSION;
75
76     package B;
77     our $VERSION = 1;
78
79     package C;
80     our %ISA;
81
82     package D;
83     our @ISA = 'Mouse::Object';
84
85     package E;
86     sub foo {}
87
88     package F;
89
90     package G::H;
91     sub bar {}
92
93     package I;
94     our $NOT_CODE = 1;
95 };
96
97 do {
98     package ClassNameTests;
99     use Mouse;
100
101     has class => (
102         is => 'rw',
103         isa => 'ClassName',
104     );
105 };
106
107 for ('B'..'E', 'G::H') {
108     lives_ok {
109         ClassNameTests->new(class => $_);
110     };
111
112     lives_ok {
113         my $obj = ClassNameTests->new;
114         $obj->class($_);
115     };
116 }
117
118 TODO: {
119     local $TODO = "Moose throws errors here. Mouse does not";
120     throws_ok {
121         ClassNameTests->new(class => 'A');
122     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/;
123
124     throws_ok {
125             my $obj = ClassNameTests->new;
126             $obj->class('A');
127     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/;
128 }
129
130 for ('F', 'G', 'I', 'Z') {
131     throws_ok {
132         ClassNameTests->new(class => $_);
133     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/;
134
135     throws_ok {
136             my $obj = ClassNameTests->new;
137             $obj->class($_);
138     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/;
139 };
140