t/020_attribute.t

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