Commit | Line | Data |
3301fa54 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
e2962c13 |
4 | use Test::More; |
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 | |
e2962c13 |
16 | has obj => ( |
17 | is => 'rw', |
18 | isa => 'UNIVERSAL', |
19 | ); |
20 | |
285764da |
21 | package Test::Builder::Subclass; |
22 | our @ISA = qw(Test::Builder); |
3301fa54 |
23 | }; |
24 | |
25 | can_ok(Class => 'tb'); |
26 | |
27 | lives_ok { |
28 | Class->new(tb => Test::Builder->new); |
29 | }; |
30 | |
31 | lives_ok { |
e2962c13 |
32 | Class->new(obj => Test::Builder->new); |
33 | }; |
34 | |
35 | lives_ok { |
285764da |
36 | # Test::Builder was a bizarre choice, because it's a singleton. Because of |
37 | # that calling new on T:B:S won't work. Blessing directly -- rjbs, |
38 | # 2008-12-04 |
39 | Class->new(tb => (bless {} => 'Test::Builder::Subclass')); |
40 | }; |
41 | |
42 | lives_ok { |
3301fa54 |
43 | my $class = Class->new; |
44 | $class->tb(Test::Builder->new); |
45 | isa_ok($class->tb, 'Test::Builder'); |
46 | }; |
47 | |
48 | throws_ok { |
49 | Class->new(tb => 3); |
537873b0 |
50 | } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' with value 3/; |
3301fa54 |
51 | |
52 | throws_ok { |
53 | my $class = Class->new; |
54 | $class->tb(3); |
537873b0 |
55 | } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' with value 3/; |
3301fa54 |
56 | |
57 | throws_ok { |
58 | Class->new(tb => Class->new); |
537873b0 |
59 | } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' with value Class=HASH\(\w+\)/; |
3301fa54 |
60 | |
e2962c13 |
61 | throws_ok { |
62 | Class->new(obj => 42); |
63 | } qr/Attribute \(obj\) does not pass the type constraint because: Validation failed for 'UNIVERSAL' with value 42/; |
64 | |
e3d9dc7b |
65 | do { |
66 | package Other; |
67 | use Mouse; |
68 | |
69 | has oops => ( |
74be9f76 |
70 | is => 'bare', |
e3d9dc7b |
71 | isa => 'Int', |
72 | default => "yikes", |
73 | ); |
74 | }; |
75 | |
76 | throws_ok { |
77 | Other->new; |
537873b0 |
78 | } qr/Attribute \(oops\) does not pass the type constraint because: Validation failed for 'Int' with value yikes/; |
e3d9dc7b |
79 | |
80 | lives_ok { |
81 | Other->new(oops => 10); |
82 | }; |
83 | |
6feb83f1 |
84 | # ClassName coverage tests |
85 | |
86 | do { |
87 | package A; |
3e8e32b5 |
88 | our @VERSION; |
6feb83f1 |
89 | |
bf8e5b90 |
90 | package Bx; # 'B' conflicts the B module |
3e8e32b5 |
91 | our $VERSION = 1; |
6feb83f1 |
92 | |
93 | package C; |
3e8e32b5 |
94 | our %ISA; |
6feb83f1 |
95 | |
3e8e32b5 |
96 | package D; |
97 | our @ISA = 'Mouse::Object'; |
6feb83f1 |
98 | |
99 | package E; |
3e8e32b5 |
100 | sub foo {} |
6feb83f1 |
101 | |
102 | package F; |
3e8e32b5 |
103 | |
104 | package G::H; |
105 | sub bar {} |
106 | |
107 | package I; |
612d3e1a |
108 | no warnings 'once'; # work around 5.6.2 |
6feb83f1 |
109 | our $NOT_CODE = 1; |
110 | }; |
111 | |
112 | do { |
113 | package ClassNameTests; |
114 | use Mouse; |
115 | |
116 | has class => ( |
117 | is => 'rw', |
118 | isa => 'ClassName', |
119 | ); |
120 | }; |
121 | |
bf8e5b90 |
122 | for ('Bx', 'D'..'E', 'G::H') { |
6feb83f1 |
123 | lives_ok { |
124 | ClassNameTests->new(class => $_); |
125 | }; |
126 | |
127 | lives_ok { |
128 | my $obj = ClassNameTests->new; |
129 | $obj->class($_); |
130 | }; |
131 | } |
132 | |
ff687069 |
133 | throws_ok { |
134 | ClassNameTests->new(class => 'A'); |
537873b0 |
135 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value A/; |
2a902f4c |
136 | |
ff687069 |
137 | throws_ok { |
138 | my $obj = ClassNameTests->new; |
139 | $obj->class('A'); |
537873b0 |
140 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value A/; |
ff687069 |
141 | |
142 | throws_ok { |
143 | ClassNameTests->new(class => 'C'); |
537873b0 |
144 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value C/; |
ff687069 |
145 | |
146 | throws_ok { |
147 | my $obj = ClassNameTests->new; |
148 | $obj->class('C'); |
537873b0 |
149 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value C/; |
2a902f4c |
150 | |
3e8e32b5 |
151 | for ('F', 'G', 'I', 'Z') { |
6feb83f1 |
152 | throws_ok { |
153 | ClassNameTests->new(class => $_); |
537873b0 |
154 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value $_/; |
6feb83f1 |
155 | |
156 | throws_ok { |
157 | my $obj = ClassNameTests->new; |
158 | $obj->class($_); |
537873b0 |
159 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value $_/; |
6feb83f1 |
160 | }; |
161 | |
5c5a61e0 |
162 | |
163 | # Check that Roles can be used in 'isa' and they are constrained with |
164 | # 'does' |
165 | do { |
166 | package SausageRole; |
167 | use Mouse::Role; |
168 | |
169 | package DoesSausage; |
170 | use Mouse; |
171 | with 'SausageRole'; |
172 | |
173 | package HasSausage; |
174 | use Mouse; |
175 | |
176 | has sausage => |
177 | (isa => 'SausageRole', |
178 | is => 'rw'); |
179 | |
180 | }; |
181 | |
182 | my $hs; |
183 | lives_ok { |
184 | $hs = HasSausage->new(sausage => DoesSausage->new); |
185 | }; |
186 | lives_ok { |
187 | $hs->sausage(DoesSausage->new); |
188 | }; |
189 | throws_ok { |
190 | HasSausage->new(sausage => Class->new); |
537873b0 |
191 | } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' with value Class=/; |
5c5a61e0 |
192 | throws_ok { |
193 | $hs->sausage(Class->new); |
537873b0 |
194 | } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' with value Class=/; |
5c5a61e0 |
195 | |
e2962c13 |
196 | done_testing; |