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" ); |
160f9ca7 |
110 | |
111 | # FIXME Regexp, Class, ClassName, Object, parametrized, filehandle |
de2f2e97 |
112 | } |
113 | |
114 | { |
4c6fbfb1 |
115 | my ( $x, $y, $z, $ref, $a, $s, $i ) = map { Foo->meta->get_attribute($_) } qw(x y z ref a s i); |
de2f2e97 |
116 | $x->Moose::XS::new_accessor("Foo::x"); |
117 | $x->Moose::XS::new_predicate("Foo::has_x"); |
118 | $y->Moose::XS::new_getter("Foo::y"); |
119 | $z->Moose::XS::new_getter("Foo::z"); |
120 | $z->Moose::XS::new_setter("Foo::set_z"); |
121 | $ref->Moose::XS::new_accessor("Foo::ref"); |
4c6fbfb1 |
122 | $a->Moose::XS::new_accessor("Foo::a"); |
123 | $s->Moose::XS::new_accessor("Foo::s"); |
124 | $i->Moose::XS::new_accessor("Foo::i"); |
1ea12c91 |
125 | } |
126 | |
1ea12c91 |
127 | |
de2f2e97 |
128 | my $ref = [ ]; |
129 | |
130 | my $foo = Foo->new( x => "ICKS", y => "WHY", z => "ZEE", ref => $ref ); |
1ea12c91 |
131 | |
132 | is( $foo->x, "ICKS" ); |
133 | is( $foo->y, "WHY" ); |
134 | is( $foo->z, "ZEE" ); |
de2f2e97 |
135 | is( $foo->ref, $ref, ); |
1ea12c91 |
136 | |
137 | lives_ok { $foo->x("YASE") }; |
138 | |
139 | is( $foo->x, "YASE" ); |
140 | |
141 | dies_ok { $foo->y("blah") }; |
142 | |
143 | is( $foo->y, "WHY" ); |
144 | |
145 | dies_ok { $foo->z("blah") }; |
146 | |
147 | is( $foo->z, "ZEE" ); |
148 | |
149 | lives_ok { $foo->set_z("new") }; |
150 | |
151 | is( $foo->z, "new" ); |
152 | |
153 | ok( $foo->has_x ); |
154 | |
155 | ok( !Foo->new->has_x ); |
156 | |
de2f2e97 |
157 | undef $ref; |
158 | |
159 | is( $foo->ref(), undef ); |
160 | |
161 | $ref = { }; |
162 | |
163 | $foo->ref($ref); |
164 | |
165 | is( $foo->ref, $ref, ); |
166 | |
167 | undef $ref; |
168 | |
169 | is( $foo->ref(), undef ); |
170 | |
4c6fbfb1 |
171 | ok( !eval { $foo->a("not a ref"); 1 } ); |
172 | ok( !eval { $foo->i(1.3); 1 } ); |
173 | ok( !eval { $foo->s(undef); 1 } ); |
174 | |
175 | ok( eval { $foo->a([]); 1 } ); |
176 | ok( eval { $foo->i(3); 1 } ); |
177 | ok( eval { $foo->s("foo"); 1 } ); |
178 | |
de2f2e97 |
179 | use Data::Dumper; |
180 | warn Dumper($foo); |