Commit | Line | Data |
3301fa54 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
285764da |
4 | use Test::More tests => 30; |
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 => ( |
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 | |
6feb83f1 |
70 | # ClassName coverage tests |
71 | |
72 | do { |
73 | package A; |
3e8e32b5 |
74 | our @VERSION; |
6feb83f1 |
75 | |
76 | package B; |
3e8e32b5 |
77 | our $VERSION = 1; |
6feb83f1 |
78 | |
79 | package C; |
3e8e32b5 |
80 | our %ISA; |
6feb83f1 |
81 | |
3e8e32b5 |
82 | package D; |
83 | our @ISA = 'Mouse::Object'; |
6feb83f1 |
84 | |
85 | package E; |
3e8e32b5 |
86 | sub foo {} |
6feb83f1 |
87 | |
88 | package F; |
3e8e32b5 |
89 | |
90 | package G::H; |
91 | sub bar {} |
92 | |
93 | package I; |
6feb83f1 |
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 | |
3e8e32b5 |
107 | for ('A'..'E', 'G::H') { |
6feb83f1 |
108 | lives_ok { |
109 | ClassNameTests->new(class => $_); |
110 | }; |
111 | |
112 | lives_ok { |
113 | my $obj = ClassNameTests->new; |
114 | $obj->class($_); |
115 | }; |
116 | } |
117 | |
3e8e32b5 |
118 | for ('F', 'G', 'I', 'Z') { |
6feb83f1 |
119 | throws_ok { |
120 | ClassNameTests->new(class => $_); |
121 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/; |
122 | |
123 | throws_ok { |
124 | my $obj = ClassNameTests->new; |
125 | $obj->class($_); |
126 | } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/; |
127 | }; |
128 | |