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 | |
bf8e5b90 |
77 | package Bx; # 'B' conflicts the B module |
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; |
612d3e1a |
95 | no warnings 'once'; # work around 5.6.2 |
6feb83f1 |
96 | our $NOT_CODE = 1; |
97 | }; |
98 | |
99 | do { |
100 | package ClassNameTests; |
101 | use Mouse; |
102 | |
103 | has class => ( |
104 | is => 'rw', |
105 | isa => 'ClassName', |
106 | ); |
107 | }; |
108 | |
bf8e5b90 |
109 | for ('Bx', 'D'..'E', 'G::H') { |
6feb83f1 |
110 | lives_ok { |
111 | ClassNameTests->new(class => $_); |
112 | }; |
113 | |
114 | lives_ok { |
115 | my $obj = ClassNameTests->new; |
116 | $obj->class($_); |
117 | }; |
118 | } |
119 | |
ff687069 |
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/; |
2a902f4c |
123 | |
ff687069 |
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 | throws_ok { |
130 | ClassNameTests->new(class => 'C'); |
131 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value C/; |
132 | |
133 | throws_ok { |
134 | my $obj = ClassNameTests->new; |
135 | $obj->class('C'); |
136 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value C/; |
2a902f4c |
137 | |
3e8e32b5 |
138 | for ('F', 'G', 'I', 'Z') { |
6feb83f1 |
139 | throws_ok { |
140 | ClassNameTests->new(class => $_); |
141 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/; |
142 | |
143 | throws_ok { |
144 | my $obj = ClassNameTests->new; |
145 | $obj->class($_); |
146 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/; |
147 | }; |
148 | |
5c5a61e0 |
149 | |
150 | # Check that Roles can be used in 'isa' and they are constrained with |
151 | # 'does' |
152 | do { |
153 | package SausageRole; |
154 | use Mouse::Role; |
155 | |
156 | package DoesSausage; |
157 | use Mouse; |
158 | with 'SausageRole'; |
159 | |
160 | package HasSausage; |
161 | use Mouse; |
162 | |
163 | has sausage => |
164 | (isa => 'SausageRole', |
165 | is => 'rw'); |
166 | |
167 | }; |
168 | |
169 | my $hs; |
170 | lives_ok { |
171 | $hs = HasSausage->new(sausage => DoesSausage->new); |
172 | }; |
173 | lives_ok { |
174 | $hs->sausage(DoesSausage->new); |
175 | }; |
176 | throws_ok { |
177 | HasSausage->new(sausage => Class->new); |
178 | } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' failed with value Class=/; |
179 | throws_ok { |
180 | $hs->sausage(Class->new); |
181 | } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' failed with value Class=/; |
182 | |