Commit | Line | Data |
013b1897 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 20; |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Class::MOP'); |
11 | use_ok('Class::MOP::Attribute'); |
12 | } |
13 | |
14 | |
15 | { |
16 | my $regexp = qr/hello (.*)/; |
17 | my $attr = Class::MOP::Attribute->new('$test' => ( |
18 | default => $regexp |
19 | )); |
20 | |
21 | ok($attr->has_default, '... we have a default value'); |
22 | is($attr->default, $regexp, '... and got the value we expected'); |
23 | } |
24 | |
25 | { # bad construtor args |
26 | dies_ok { |
27 | Class::MOP::Attribute->new(); |
28 | } '... no name argument'; |
29 | |
30 | dies_ok { |
31 | Class::MOP::Attribute->new(''); |
32 | } '... bad name argument'; |
33 | |
34 | dies_ok { |
35 | Class::MOP::Attribute->new(0); |
36 | } '... bad name argument'; |
37 | } |
38 | |
39 | { |
40 | my $attr = Class::MOP::Attribute->new('$test'); |
41 | dies_ok { |
42 | $attr->attach_to_class(); |
43 | } '... attach_to_class died as expected'; |
44 | |
45 | dies_ok { |
46 | $attr->attach_to_class('Fail'); |
47 | } '... attach_to_class died as expected'; |
48 | |
49 | dies_ok { |
50 | $attr->attach_to_class(bless {} => 'Fail'); |
51 | } '... attach_to_class died as expected'; |
52 | } |
53 | |
54 | { |
55 | my $attr = Class::MOP::Attribute->new('$test' => ( |
56 | reader => [ 'whoops, this wont work' ] |
57 | )); |
58 | |
59 | $attr->attach_to_class(Class::MOP::Class->initialize('Foo')); |
60 | |
61 | dies_ok { |
62 | $attr->install_accessors; |
63 | } '... bad reader format'; |
64 | } |
65 | |
66 | { |
67 | my $attr = Class::MOP::Attribute->new('$test'); |
68 | |
69 | dies_ok { |
70 | $attr->process_accessors('fail', 'my_failing_sub'); |
71 | } '... cannot find "fail" type generator'; |
72 | } |
73 | |
74 | |
75 | { |
76 | { |
77 | package My::Attribute; |
78 | our @ISA = ('Class::MOP::Attribute'); |
79 | sub generate_reader_method { eval { die } } |
80 | } |
81 | |
82 | my $attr = My::Attribute->new('$test' => ( |
83 | reader => 'test' |
84 | )); |
85 | |
86 | dies_ok { |
87 | $attr->install_accessors; |
88 | } '... failed to generate accessors correctly'; |
89 | } |
90 | |
91 | { |
92 | my $attr = Class::MOP::Attribute->new('$test' => ( |
93 | predicate => 'has_test' |
94 | )); |
95 | |
96 | my $Bar = Class::MOP::Class->create('Bar' => '0.01'); |
97 | isa_ok($Bar, 'Class::MOP::Class'); |
98 | |
99 | $Bar->add_attribute($attr); |
100 | |
101 | can_ok('Bar', 'has_test'); |
102 | |
103 | is($attr, $Bar->remove_attribute('$test'), '... removed the $test attribute'); |
104 | |
105 | ok(!Bar->can('has_test'), '... Bar no longer has the "has_test" method'); |
106 | } |
107 | |
108 | |
109 | { |
110 | # NOTE: |
111 | # the next three tests once tested that |
112 | # the code would fail, but we lifted the |
113 | # restriction so you can have an accessor |
114 | # along with a reader/writer pair (I mean |
115 | # why not really). So now they test that |
116 | # it works, which is kinda silly, but it |
117 | # tests the API change, so I keep it. |
118 | |
119 | lives_ok { |
120 | Class::MOP::Attribute->new('$foo', ( |
121 | accessor => 'foo', |
122 | reader => 'get_foo', |
123 | )); |
124 | } '... can create accessors with reader/writers'; |
125 | |
126 | lives_ok { |
127 | Class::MOP::Attribute->new('$foo', ( |
128 | accessor => 'foo', |
129 | writer => 'set_foo', |
130 | )); |
131 | } '... can create accessors with reader/writers'; |
132 | |
133 | lives_ok { |
134 | Class::MOP::Attribute->new('$foo', ( |
135 | accessor => 'foo', |
136 | reader => 'get_foo', |
137 | writer => 'set_foo', |
138 | )); |
139 | } '... can create accessors with reader/writers'; |
140 | } |