Commit | Line | Data |
3301fa54 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
5c5a61e0 |
4 | use Test::More tests => 34; |
eab81545 |
5 | use Test::Exception; |
3301fa54 |
6 | |
7 | do { |
8 | package Class; |
9 | use Mouse; |
10 | |
11 | has tb => ( |
12 | is => 'rw', |
13 | isa => 'Test::Builder', |
14 | ); |
285764da |
15 | |
16 | package Test::Builder::Subclass; |
17 | our @ISA = qw(Test::Builder); |
3301fa54 |
18 | }; |
19 | |
20 | can_ok(Class => 'tb'); |
21 | |
22 | lives_ok { |
23 | Class->new(tb => Test::Builder->new); |
24 | }; |
25 | |
26 | lives_ok { |
285764da |
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 { |
3301fa54 |
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 | |
e3d9dc7b |
52 | do { |
53 | package Other; |
54 | use Mouse; |
55 | |
56 | has oops => ( |
74be9f76 |
57 | is => 'bare', |
e3d9dc7b |
58 | isa => 'Int', |
59 | default => "yikes", |
60 | ); |
61 | }; |
62 | |
63 | throws_ok { |
64 | Other->new; |
65 | } qr/Attribute \(oops\) does not pass the type constraint because: Validation failed for 'Int' failed with value yikes/; |
66 | |
67 | lives_ok { |
68 | Other->new(oops => 10); |
69 | }; |
70 | |
6feb83f1 |
71 | # ClassName coverage tests |
72 | |
73 | do { |
74 | package A; |
3e8e32b5 |
75 | our @VERSION; |
6feb83f1 |
76 | |
77 | package B; |
3e8e32b5 |
78 | our $VERSION = 1; |
6feb83f1 |
79 | |
80 | package C; |
3e8e32b5 |
81 | our %ISA; |
6feb83f1 |
82 | |
3e8e32b5 |
83 | package D; |
84 | our @ISA = 'Mouse::Object'; |
6feb83f1 |
85 | |
86 | package E; |
3e8e32b5 |
87 | sub foo {} |
6feb83f1 |
88 | |
89 | package F; |
3e8e32b5 |
90 | |
91 | package G::H; |
92 | sub bar {} |
93 | |
94 | package I; |
6feb83f1 |
95 | our $NOT_CODE = 1; |
96 | }; |
97 | |
98 | do { |
99 | package ClassNameTests; |
100 | use Mouse; |
101 | |
102 | has class => ( |
103 | is => 'rw', |
104 | isa => 'ClassName', |
105 | ); |
106 | }; |
107 | |
ff687069 |
108 | for ('B', 'D'..'E', 'G::H') { |
6feb83f1 |
109 | lives_ok { |
110 | ClassNameTests->new(class => $_); |
111 | }; |
112 | |
113 | lives_ok { |
114 | my $obj = ClassNameTests->new; |
115 | $obj->class($_); |
116 | }; |
117 | } |
118 | |
ff687069 |
119 | throws_ok { |
120 | ClassNameTests->new(class => 'A'); |
121 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/; |
2a902f4c |
122 | |
ff687069 |
123 | throws_ok { |
124 | my $obj = ClassNameTests->new; |
125 | $obj->class('A'); |
126 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/; |
127 | |
128 | throws_ok { |
129 | ClassNameTests->new(class => 'C'); |
130 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value C/; |
131 | |
132 | throws_ok { |
133 | my $obj = ClassNameTests->new; |
134 | $obj->class('C'); |
135 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value C/; |
2a902f4c |
136 | |
3e8e32b5 |
137 | for ('F', 'G', 'I', 'Z') { |
6feb83f1 |
138 | throws_ok { |
139 | ClassNameTests->new(class => $_); |
140 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/; |
141 | |
142 | throws_ok { |
143 | my $obj = ClassNameTests->new; |
144 | $obj->class($_); |
145 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/; |
146 | }; |
147 | |
5c5a61e0 |
148 | |
149 | # Check that Roles can be used in 'isa' and they are constrained with |
150 | # 'does' |
151 | do { |
152 | package SausageRole; |
153 | use Mouse::Role; |
154 | |
155 | package DoesSausage; |
156 | use Mouse; |
157 | with 'SausageRole'; |
158 | |
159 | package HasSausage; |
160 | use Mouse; |
161 | |
162 | has sausage => |
163 | (isa => 'SausageRole', |
164 | is => 'rw'); |
165 | |
166 | }; |
167 | |
168 | my $hs; |
169 | lives_ok { |
170 | $hs = HasSausage->new(sausage => DoesSausage->new); |
171 | }; |
172 | lives_ok { |
173 | $hs->sausage(DoesSausage->new); |
174 | }; |
175 | throws_ok { |
176 | HasSausage->new(sausage => Class->new); |
177 | } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' failed with value Class=/; |
178 | throws_ok { |
179 | $hs->sausage(Class->new); |
180 | } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' failed with value Class=/; |
181 | |