t/020_attribute.t

   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;