| Commit | Line | Data |
|---|
| 38bf2a25 |
1 | use strict; |
| 2 | use warnings; |
| 3 | |
| 4 | use Scalar::Util 'reftype', 'blessed'; |
| 5 | |
| 6 | use Test::More; |
| 7 | use Test::Fatal; |
| 8 | |
| 9 | use Class::MOP; |
| 10 | use Class::MOP::Attribute; |
| 11 | use Class::MOP::Method; |
| 12 | |
| 13 | |
| 14 | isnt( exception { Class::MOP::Attribute->name }, undef, q{... can't call name() as a class method} ); |
| 15 | |
| 16 | |
| 17 | { |
| 18 | my $attr = Class::MOP::Attribute->new('$foo'); |
| 19 | isa_ok($attr, 'Class::MOP::Attribute'); |
| 20 | |
| 21 | is($attr->name, '$foo', '... $attr->name == $foo'); |
| 22 | ok($attr->has_init_arg, '... $attr does have an init_arg'); |
| 23 | is($attr->init_arg, '$foo', '... $attr init_arg is the name'); |
| 24 | |
| 25 | ok(!$attr->has_accessor, '... $attr does not have an accessor'); |
| 26 | ok(!$attr->has_reader, '... $attr does not have an reader'); |
| 27 | ok(!$attr->has_writer, '... $attr does not have an writer'); |
| 28 | ok(!$attr->has_default, '... $attr does not have an default'); |
| 29 | ok(!$attr->has_builder, '... $attr does not have a builder'); |
| 30 | |
| 31 | { |
| 32 | my $reader = $attr->get_read_method_ref; |
| 33 | my $writer = $attr->get_write_method_ref; |
| 34 | |
| 35 | ok(!blessed($reader), '... it is a plain old sub'); |
| 36 | ok(!blessed($writer), '... it is a plain old sub'); |
| 37 | |
| 38 | is(reftype($reader), 'CODE', '... it is a plain old sub'); |
| 39 | is(reftype($writer), 'CODE', '... it is a plain old sub'); |
| 40 | } |
| 41 | |
| 42 | my $class = Class::MOP::Class->initialize('Foo'); |
| 43 | isa_ok($class, 'Class::MOP::Class'); |
| 44 | |
| 45 | is( exception { |
| 46 | $attr->attach_to_class($class); |
| 47 | }, undef, '... attached a class successfully' ); |
| 48 | |
| 49 | is($attr->associated_class, $class, '... the class was associated correctly'); |
| 50 | |
| 51 | ok(!$attr->get_read_method, '... $attr does not have an read method'); |
| 52 | ok(!$attr->get_write_method, '... $attr does not have an write method'); |
| 53 | |
| 54 | { |
| 55 | my $reader = $attr->get_read_method_ref; |
| 56 | my $writer = $attr->get_write_method_ref; |
| 57 | |
| 58 | ok(blessed($reader), '... it is a plain old sub'); |
| 59 | ok(blessed($writer), '... it is a plain old sub'); |
| 60 | |
| 61 | isa_ok($reader, 'Class::MOP::Method'); |
| 62 | isa_ok($writer, 'Class::MOP::Method'); |
| 63 | } |
| 64 | |
| 65 | my $attr_clone = $attr->clone(); |
| 66 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
| 67 | isnt($attr, $attr_clone, '... but they are different instances'); |
| 68 | |
| 69 | is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though'); |
| 70 | is($attr->associated_class, $class, '... the associated classes are the same though'); |
| 71 | is($attr_clone->associated_class, $class, '... the associated classes are the same though'); |
| 72 | |
| 73 | is_deeply($attr, $attr_clone, '... but they are the same inside'); |
| 74 | } |
| 75 | |
| 76 | { |
| 77 | my $attr = Class::MOP::Attribute->new('$foo', ( |
| 78 | init_arg => '-foo', |
| 79 | default => 'BAR' |
| 80 | )); |
| 81 | isa_ok($attr, 'Class::MOP::Attribute'); |
| 82 | |
| 83 | is($attr->name, '$foo', '... $attr->name == $foo'); |
| 84 | |
| 85 | ok($attr->has_init_arg, '... $attr does have an init_arg'); |
| 86 | is($attr->init_arg, '-foo', '... $attr->init_arg == -foo'); |
| 87 | ok($attr->has_default, '... $attr does have an default'); |
| 88 | is($attr->default, 'BAR', '... $attr->default == BAR'); |
| 89 | ok(!$attr->has_builder, '... $attr does not have a builder'); |
| 90 | |
| 91 | ok(!$attr->has_accessor, '... $attr does not have an accessor'); |
| 92 | ok(!$attr->has_reader, '... $attr does not have an reader'); |
| 93 | ok(!$attr->has_writer, '... $attr does not have an writer'); |
| 94 | |
| 95 | ok(!$attr->get_read_method, '... $attr does not have an read method'); |
| 96 | ok(!$attr->get_write_method, '... $attr does not have an write method'); |
| 97 | |
| 98 | { |
| 99 | my $reader = $attr->get_read_method_ref; |
| 100 | my $writer = $attr->get_write_method_ref; |
| 101 | |
| 102 | ok(!blessed($reader), '... it is a plain old sub'); |
| 103 | ok(!blessed($writer), '... it is a plain old sub'); |
| 104 | |
| 105 | is(reftype($reader), 'CODE', '... it is a plain old sub'); |
| 106 | is(reftype($writer), 'CODE', '... it is a plain old sub'); |
| 107 | } |
| 108 | |
| 109 | my $attr_clone = $attr->clone(); |
| 110 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
| 111 | isnt($attr, $attr_clone, '... but they are different instances'); |
| 112 | |
| 113 | is($attr->associated_class, $attr_clone->associated_class, '... the associated classes are the same though'); |
| 114 | is($attr->associated_class, undef, '... the associated class is actually undef'); |
| 115 | is($attr_clone->associated_class, undef, '... the associated class is actually undef'); |
| 116 | |
| 117 | is_deeply($attr, $attr_clone, '... but they are the same inside'); |
| 118 | } |
| 119 | |
| 120 | { |
| 121 | my $attr = Class::MOP::Attribute->new('$foo', ( |
| 122 | accessor => 'foo', |
| 123 | init_arg => '-foo', |
| 124 | default => 'BAR' |
| 125 | )); |
| 126 | isa_ok($attr, 'Class::MOP::Attribute'); |
| 127 | |
| 128 | is($attr->name, '$foo', '... $attr->name == $foo'); |
| 129 | |
| 130 | ok($attr->has_init_arg, '... $attr does have an init_arg'); |
| 131 | is($attr->init_arg, '-foo', '... $attr->init_arg == -foo'); |
| 132 | ok($attr->has_default, '... $attr does have an default'); |
| 133 | is($attr->default, 'BAR', '... $attr->default == BAR'); |
| 134 | |
| 135 | ok($attr->has_accessor, '... $attr does have an accessor'); |
| 136 | is($attr->accessor, 'foo', '... $attr->accessor == foo'); |
| 137 | |
| 138 | ok(!$attr->has_reader, '... $attr does not have an reader'); |
| 139 | ok(!$attr->has_writer, '... $attr does not have an writer'); |
| 140 | |
| 141 | is($attr->get_read_method, 'foo', '... $attr does not have an read method'); |
| 142 | is($attr->get_write_method, 'foo', '... $attr does not have an write method'); |
| 143 | |
| 144 | { |
| 145 | my $reader = $attr->get_read_method_ref; |
| 146 | my $writer = $attr->get_write_method_ref; |
| 147 | |
| 148 | ok(!blessed($reader), '... it is not a plain old sub'); |
| 149 | ok(!blessed($writer), '... it is not a plain old sub'); |
| 150 | |
| 151 | is(reftype($reader), 'CODE', '... it is a plain old sub'); |
| 152 | is(reftype($writer), 'CODE', '... it is a plain old sub'); |
| 153 | } |
| 154 | |
| 155 | my $attr_clone = $attr->clone(); |
| 156 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
| 157 | isnt($attr, $attr_clone, '... but they are different instances'); |
| 158 | |
| 159 | is_deeply($attr, $attr_clone, '... but they are the same inside'); |
| 160 | } |
| 161 | |
| 162 | { |
| 163 | my $attr = Class::MOP::Attribute->new('$foo', ( |
| 164 | reader => 'get_foo', |
| 165 | writer => 'set_foo', |
| 166 | init_arg => '-foo', |
| 167 | default => 'BAR' |
| 168 | )); |
| 169 | isa_ok($attr, 'Class::MOP::Attribute'); |
| 170 | |
| 171 | is($attr->name, '$foo', '... $attr->name == $foo'); |
| 172 | |
| 173 | ok($attr->has_init_arg, '... $attr does have an init_arg'); |
| 174 | is($attr->init_arg, '-foo', '... $attr->init_arg == -foo'); |
| 175 | ok($attr->has_default, '... $attr does have an default'); |
| 176 | is($attr->default, 'BAR', '... $attr->default == BAR'); |
| 177 | |
| 178 | ok($attr->has_reader, '... $attr does have an reader'); |
| 179 | is($attr->reader, 'get_foo', '... $attr->reader == get_foo'); |
| 180 | ok($attr->has_writer, '... $attr does have an writer'); |
| 181 | is($attr->writer, 'set_foo', '... $attr->writer == set_foo'); |
| 182 | |
| 183 | ok(!$attr->has_accessor, '... $attr does not have an accessor'); |
| 184 | |
| 185 | is($attr->get_read_method, 'get_foo', '... $attr does not have an read method'); |
| 186 | is($attr->get_write_method, 'set_foo', '... $attr does not have an write method'); |
| 187 | |
| 188 | { |
| 189 | my $reader = $attr->get_read_method_ref; |
| 190 | my $writer = $attr->get_write_method_ref; |
| 191 | |
| 192 | ok(!blessed($reader), '... it is not a plain old sub'); |
| 193 | ok(!blessed($writer), '... it is not a plain old sub'); |
| 194 | |
| 195 | is(reftype($reader), 'CODE', '... it is a plain old sub'); |
| 196 | is(reftype($writer), 'CODE', '... it is a plain old sub'); |
| 197 | } |
| 198 | |
| 199 | my $attr_clone = $attr->clone(); |
| 200 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
| 201 | isnt($attr, $attr_clone, '... but they are different instances'); |
| 202 | |
| 203 | is_deeply($attr, $attr_clone, '... but they are the same inside'); |
| 204 | } |
| 205 | |
| 206 | { |
| 207 | my $attr = Class::MOP::Attribute->new('$foo'); |
| 208 | isa_ok($attr, 'Class::MOP::Attribute'); |
| 209 | |
| 210 | my $attr_clone = $attr->clone('name' => '$bar'); |
| 211 | isa_ok($attr_clone, 'Class::MOP::Attribute'); |
| 212 | isnt($attr, $attr_clone, '... but they are different instances'); |
| 213 | |
| 214 | isnt($attr->name, $attr_clone->name, '... we changes the name parameter'); |
| 215 | |
| 216 | is($attr->name, '$foo', '... $attr->name == $foo'); |
| 217 | is($attr_clone->name, '$bar', '... $attr_clone->name == $bar'); |
| 218 | } |
| 219 | |
| 220 | { |
| 221 | my $attr = Class::MOP::Attribute->new('$foo', (builder => 'foo_builder')); |
| 222 | isa_ok($attr, 'Class::MOP::Attribute'); |
| 223 | |
| 224 | ok(!$attr->has_default, '... $attr does not have a default'); |
| 225 | ok($attr->has_builder, '... $attr does have a builder'); |
| 226 | is($attr->builder, 'foo_builder', '... $attr->builder == foo_builder'); |
| 227 | |
| 228 | } |
| 229 | |
| 230 | { |
| 231 | for my $value ({}, bless({}, 'Foo')) { |
| 232 | like( exception { |
| 233 | Class::MOP::Attribute->new('$foo', default => $value); |
| 234 | }, qr/References are not allowed as default values/ ); |
| 235 | } |
| 236 | } |
| 237 | |
| 238 | { |
| 239 | my $attr; |
| 240 | is( exception { |
| 241 | my $meth = Class::MOP::Method->wrap(sub {shift}, name => 'foo', package_name => 'bar'); |
| 242 | $attr = Class::MOP::Attribute->new('$foo', default => $meth); |
| 243 | }, undef, 'Class::MOP::Methods accepted as default' ); |
| 244 | |
| 245 | is($attr->default(42), 42, 'passthrough for default on attribute'); |
| 246 | } |
| 247 | |
| 248 | done_testing; |
projects / gitmo/Moose.git / blame