Commit | Line | Data |
1ea12c91 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More; |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | plan skip_all => "no XSLoader" unless eval { require XSLoader }; |
11 | |
12 | plan skip_all => $@ unless eval { |
13 | require Moose; |
14 | Moose->XSLoader::load($Moose::VERSION); |
15 | 1; |
16 | }; |
17 | |
18 | plan 'no_plan'; |
19 | } |
20 | |
f253044f |
21 | { |
22 | package Moose::XS; |
23 | |
24 | sub attr_to_meta_instance { |
25 | my $attr = shift; |
26 | return $attr->associated_class->get_meta_instance; |
27 | } |
28 | |
160f9ca7 |
29 | my $i; |
30 | my %checks = map { $_ => $i++ } qw( |
31 | Any |
32 | Undef |
33 | Defined |
34 | Str |
35 | Num |
36 | Int |
37 | GlobRef |
38 | ArrayRef |
39 | HashRef |
40 | CodeRef |
41 | Ref |
42 | ScalarRef |
43 | FileHandle |
44 | RegexpRef |
45 | Object |
46 | ClassName |
47 | ); |
48 | |
49 | # aliases |
50 | $checks{Bool} = $checks{Item} = $checks{Any}; |
51 | $checks{Value} = $checks{Str}; |
52 | |
53 | sub tc_params { |
54 | my $tc = shift; |
55 | |
56 | return ( undef, 0, undef ) unless $tc; |
57 | |
58 | if ( ref $tc eq 'Moose::Meta::TypeConstraint' or ref $tc eq 'Moose::Meta::TypeConstraint::Parameterizable') { |
59 | # builtin moose type # |
60 | return ( $tc, 1, $checks{$tc->name} ); |
61 | } elsif ( $tc->isa("Moose::Meta::TypeConstraint::Class") ) { |
62 | return ( $tc, 2, $tc->class ); |
63 | } else { |
64 | warn ref $tc; |
65 | return ( $tc, 3, $tc->_compiled_type_constraint ); |
66 | } |
67 | } |
68 | |
f253044f |
69 | sub meta_instance_to_attr_descs { |
70 | my $mi = shift; |
71 | |
72 | return ( |
73 | $mi->associated_metaclass->name, |
160f9ca7 |
74 | [ map {[ |
75 | $_, |
76 | [$_->slots], |
77 | |
78 | $_->is_weak_ref, |
79 | $_->should_coerce, |
80 | $_->is_lazy, |
81 | |
82 | tc_params($_->type_constraint), |
83 | $_->trigger, |
84 | $_->initializer, |
85 | |
86 | $_->has_default, |
87 | $_->default, |
88 | $_->builder, |
89 | ]} $mi->get_all_attributes ] |
f253044f |
90 | ); |
91 | } |
92 | } |
93 | |
de2f2e97 |
94 | ok( defined &Moose::XS::new_getter ); |
95 | ok( defined &Moose::XS::new_setter ); |
96 | ok( defined &Moose::XS::new_accessor ); |
97 | ok( defined &Moose::XS::new_predicate ); |
1ea12c91 |
98 | |
99 | { |
100 | package Foo; |
101 | use Moose; |
102 | |
103 | has x => ( is => "rw", predicate => "has_x" ); |
104 | has y => ( is => "ro" ); |
105 | has z => ( reader => "z", setter => "set_z" ); |
de2f2e97 |
106 | has ref => ( is => "rw", weak_ref => 1 ); |
4c6fbfb1 |
107 | has i => ( isa => "Int", is => "rw" ); |
108 | has s => ( isa => "Str", is => "rw" ); |
109 | has a => ( isa => "ArrayRef", is => "rw" ); |
a812574b |
110 | has o => ( isa => "Object", is => "rw" ); |
111 | has f => ( isa => "Foo", is => "rw" ); |
112 | has c => ( isa => "ClassName", is => "rw" ); |
160f9ca7 |
113 | |
a812574b |
114 | # FIXME Regexp, ScalarRef, parametrized, filehandle |
7ce1a351 |
115 | |
116 | package Gorch; |
117 | use Moose; |
118 | |
119 | extends qw(Foo); |
120 | |
121 | package Quxx; |
122 | use Moose; |
123 | |
124 | sub isa { |
125 | return $_[1] eq 'Foo'; |
126 | } |
de2f2e97 |
127 | } |
128 | |
129 | { |
a812574b |
130 | my ( $x, $y, $z, $ref, $a, $s, $i, $o, $f, $c ) = map { Foo->meta->get_attribute($_) } qw(x y z ref a s i o f c); |
de2f2e97 |
131 | $x->Moose::XS::new_accessor("Foo::x"); |
132 | $x->Moose::XS::new_predicate("Foo::has_x"); |
133 | $y->Moose::XS::new_getter("Foo::y"); |
134 | $z->Moose::XS::new_getter("Foo::z"); |
135 | $z->Moose::XS::new_setter("Foo::set_z"); |
136 | $ref->Moose::XS::new_accessor("Foo::ref"); |
4c6fbfb1 |
137 | $a->Moose::XS::new_accessor("Foo::a"); |
138 | $s->Moose::XS::new_accessor("Foo::s"); |
139 | $i->Moose::XS::new_accessor("Foo::i"); |
a812574b |
140 | $o->Moose::XS::new_accessor("Foo::o"); |
141 | $f->Moose::XS::new_accessor("Foo::f"); |
142 | $c->Moose::XS::new_accessor("Foo::c"); |
1ea12c91 |
143 | } |
144 | |
1ea12c91 |
145 | |
de2f2e97 |
146 | my $ref = [ ]; |
147 | |
148 | my $foo = Foo->new( x => "ICKS", y => "WHY", z => "ZEE", ref => $ref ); |
1ea12c91 |
149 | |
150 | is( $foo->x, "ICKS" ); |
151 | is( $foo->y, "WHY" ); |
152 | is( $foo->z, "ZEE" ); |
de2f2e97 |
153 | is( $foo->ref, $ref, ); |
1ea12c91 |
154 | |
155 | lives_ok { $foo->x("YASE") }; |
156 | |
157 | is( $foo->x, "YASE" ); |
158 | |
159 | dies_ok { $foo->y("blah") }; |
160 | |
161 | is( $foo->y, "WHY" ); |
162 | |
163 | dies_ok { $foo->z("blah") }; |
164 | |
165 | is( $foo->z, "ZEE" ); |
166 | |
167 | lives_ok { $foo->set_z("new") }; |
168 | |
169 | is( $foo->z, "new" ); |
170 | |
171 | ok( $foo->has_x ); |
172 | |
173 | ok( !Foo->new->has_x ); |
174 | |
de2f2e97 |
175 | undef $ref; |
176 | |
177 | is( $foo->ref(), undef ); |
178 | |
179 | $ref = { }; |
180 | |
181 | $foo->ref($ref); |
182 | |
183 | is( $foo->ref, $ref, ); |
184 | |
185 | undef $ref; |
186 | |
187 | is( $foo->ref(), undef ); |
188 | |
7ce1a351 |
189 | ok( !eval { $foo->a("not a ref"); 1 }, "ArrayRef" ); |
190 | ok( !eval { $foo->a(3); 1 }, "ArrayRef" ); |
191 | ok( !eval { $foo->a({}); 1 }, "ArrayRef" ); |
192 | ok( !eval { $foo->a(undef); 1 }, "ArrayRef" ); |
193 | ok( !eval { $foo->i(1.3); 1 }, "Int" ); |
194 | ok( !eval { $foo->i("1.3"); 1 }, "Int" ); |
195 | ok( !eval { $foo->i("foo"); 1 }, "Int" ); |
196 | ok( !eval { $foo->i(undef); 1 }, "Int" ); |
197 | ok( !eval { $foo->s(undef); 1 }, "Str" ); |
198 | ok( !eval { $foo->s([]); 1 }, "Str" ); |
199 | ok( !eval { $foo->o({}); 1 }, "Object" ); |
200 | ok( !eval { $foo->o(undef); 1 }, "Object" ); |
201 | ok( !eval { $foo->o(42); 1 }, "Object" ); |
202 | ok( !eval { $foo->o("hi ho"); 1 }, "Object" ); |
203 | ok( !eval { $foo->o(" ho"); 1 }, "Object" ); |
204 | ok( !eval { $foo->f(bless {}, "Bar"); 1 }, "Class (Foo)" ); |
205 | ok( !eval { $foo->f(undef); 1 }, "Class (Foo)" ); |
206 | ok( !eval { $foo->f("foo"); 1 }, "Class (Foo)" ); |
207 | ok( !eval { $foo->f(3); 1 }, "Class (Foo)" ); |
208 | ok( !eval { $foo->f({}); 1 }, "Class (Foo)" ); |
209 | ok( !eval { $foo->f("Foo"); 1 }, "Class (Foo)" ); |
210 | ok( !eval { $foo->c("Horse"); 1 }, "ClassName" ); |
211 | ok( !eval { $foo->c(3); 1 }, "ClassName" ); |
212 | ok( !eval { $foo->c(undef); 1 }, "ClassName" ); |
213 | ok( !eval { $foo->c("feck"); 1 }, "ClassName" ); |
214 | ok( !eval { $foo->c({}); 1 }, "ClassName" ); |
215 | |
216 | ok( eval { $foo->a([]); 1 }, "ArrayRef" ); |
217 | ok( eval { $foo->i(3); 1 }, "Int" ); |
218 | ok( eval { $foo->i("3"); 1 }, "Int" ); |
219 | ok( eval { $foo->i("-3"); 1 }, "Int" ); |
0be3b17f |
220 | ok( eval { $foo->i(" -3 "); 1 }, "Int" ); |
7ce1a351 |
221 | ok( eval { $foo->s("foo"); 1 }, "Str" ); |
222 | ok( eval { $foo->s(""); 1 }, "Str" ); |
223 | ok( eval { $foo->s(4); 1 }, "Str" ); |
224 | ok( eval { $foo->o(bless {}, "Bar"); 1 }, "Object" ); |
225 | ok( eval { $foo->f(Foo->new); 1 }, "Class (Foo)" ); |
226 | ok( eval { $foo->f(Gorch->new); 1 }, "Class (Foo), real subclass"); |
227 | ok( eval { $foo->f(Quxx->new); 1 }, "Class (Foo), fake subclass"); |
228 | ok( eval { $foo->c("Foo"); 1 }, "ClassName" ); |
229 | |
230 | |
231 | |
232 | $foo->meta->invalidate_meta_instance(); |
233 | isa_ok( $foo->f, 'Foo' ); |
234 | $foo->meta->invalidate_meta_instance(); |
235 | isa_ok( $foo->f, 'Foo' ); |