t/020_attribute.t

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