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