t/020_attribute.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 62;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Class::MOP');
  11     use_ok('Class::MOP::Attribute');
  12 }
  13
  14 {
  15     my $attr = Class::MOP::Attribute->new('$foo');
  16     isa_ok($attr, 'Class::MOP::Attribute');
  17
  18     is($attr->name, '$foo', '... $attr->name == $foo');
  19     ok($attr->has_init_arg, '... $attr does have an init_arg');
  20     is($attr->init_arg, '$foo', '... $attr init_arg is the name');
  21
  22     ok(!$attr->has_accessor, '... $attr does not have an accessor');
  23     ok(!$attr->has_reader, '... $attr does not have an reader');
  24     ok(!$attr->has_writer, '... $attr does not have an writer');
  25     ok(!$attr->has_default, '... $attr does not have an default');
  26
  27     my $attr_clone = $attr->clone();
  28     isa_ok($attr_clone, 'Class::MOP::Attribute');
  29     isnt($attr, $attr_clone, '... but they are different instances');
  30
  31     is_deeply($attr, $attr_clone, '... but they are the same inside');
  32 }
  33
  34 {
  35     my $attr = Class::MOP::Attribute->new('$foo', (
  36         init_arg => '-foo',
  37         default  => 'BAR'
  38     ));
  39     isa_ok($attr, 'Class::MOP::Attribute');
  40
  41     is($attr->name, '$foo', '... $attr->name == $foo');
  42
  43     ok($attr->has_init_arg, '... $attr does have an init_arg');
  44     is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
  45     ok($attr->has_default, '... $attr does have an default');
  46     is($attr->default, 'BAR', '... $attr->default == BAR');
  47
  48     ok(!$attr->has_accessor, '... $attr does not have an accessor');
  49     ok(!$attr->has_reader, '... $attr does not have an reader');
  50     ok(!$attr->has_writer, '... $attr does not have an writer');
  51
  52     my $attr_clone = $attr->clone();
  53     isa_ok($attr_clone, 'Class::MOP::Attribute');
  54     isnt($attr, $attr_clone, '... but they are different instances');
  55
  56     is_deeply($attr, $attr_clone, '... but they are the same inside');
  57 }
  58
  59 {
  60     my $attr = Class::MOP::Attribute->new('$foo', (
  61         accessor => 'foo',
  62         init_arg => '-foo',
  63         default  => 'BAR'
  64     ));
  65     isa_ok($attr, 'Class::MOP::Attribute');
  66
  67     is($attr->name, '$foo', '... $attr->name == $foo');
  68
  69     ok($attr->has_init_arg, '... $attr does have an init_arg');
  70     is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
  71     ok($attr->has_default, '... $attr does have an default');
  72     is($attr->default, 'BAR', '... $attr->default == BAR');
  73
  74     ok($attr->has_accessor, '... $attr does have an accessor');
  75     is($attr->accessor, 'foo', '... $attr->accessor == foo');
  76
  77     ok(!$attr->has_reader, '... $attr does not have an reader');
  78     ok(!$attr->has_writer, '... $attr does not have an writer');
  79
  80     my $attr_clone = $attr->clone();
  81     isa_ok($attr_clone, 'Class::MOP::Attribute');
  82     isnt($attr, $attr_clone, '... but they are different instnaces');
  83
  84     is_deeply($attr, $attr_clone, '... but they are the same inside');
  85 }
  86
  87 {
  88     my $attr = Class::MOP::Attribute->new('$foo', (
  89         reader   => 'get_foo',
  90         writer   => 'set_foo',
  91         init_arg => '-foo',
  92         default  => 'BAR'
  93     ));
  94     isa_ok($attr, 'Class::MOP::Attribute');
  95
  96     is($attr->name, '$foo', '... $attr->name == $foo');
  97
  98     ok($attr->has_init_arg, '... $attr does have an init_arg');
  99     is($attr->init_arg, '-foo', '... $attr->init_arg == -foo');
 100     ok($attr->has_default, '... $attr does have an default');
 101     is($attr->default, 'BAR', '... $attr->default == BAR');
 102
 103     ok($attr->has_reader, '... $attr does have an reader');
 104     is($attr->reader, 'get_foo', '... $attr->reader == get_foo');
 105     ok($attr->has_writer, '... $attr does have an writer');
 106     is($attr->writer, 'set_foo', '... $attr->writer == set_foo');
 107
 108     ok(!$attr->has_accessor, '... $attr does not have an accessor');
 109
 110     my $attr_clone = $attr->clone();
 111     isa_ok($attr_clone, 'Class::MOP::Attribute');
 112     isnt($attr, $attr_clone, '... but they are different instnaces');
 113
 114     is_deeply($attr, $attr_clone, '... but they are the same inside');
 115 }
 116
 117 # NOTE:
 118 # the next three tests once tested that
 119 # the code would fail, but we lifted the
 120 # restriction so you can have an accessor
 121 # along with a reader/writer pair (I mean
 122 # why not really). So now they test that
 123 # it works, which is kinda silly, but it
 124 # tests the API change, so I keep it.
 125
 126 lives_ok {
 127     Class::MOP::Attribute->new('$foo', (
 128         accessor => 'foo',
 129         reader   => 'get_foo',
 130     ));
 131 } '... can create accessors with reader/writers';
 132
 133 lives_ok {
 134     Class::MOP::Attribute->new('$foo', (
 135         accessor => 'foo',
 136         writer   => 'set_foo',
 137     ));
 138 } '... can create accessors with reader/writers';
 139
 140 lives_ok {
 141     Class::MOP::Attribute->new('$foo', (
 142         accessor => 'foo',
 143         reader   => 'get_foo',
 144         writer   => 'set_foo',
 145     ));
 146 } '... can create accessors with reader/writers';
 147
 148 dies_ok {
 149     Class::MOP::Attribute->new();
 150 } '... no name argument';
 151
 152 dies_ok {
 153     Class::MOP::Attribute->new('');
 154 } '... bad name argument';
 155
 156 dies_ok {
 157     Class::MOP::Attribute->new(0);
 158 } '... bad name argument';
 159
 160 dies_ok {
 161     Class::MOP::Attribute->install_accessors();
 162 } '... bad install_accessors argument';
 163
 164 dies_ok {
 165     Class::MOP::Attribute->install_accessors(bless {} => 'Fail');
 166 } '... bad install_accessors argument';
 167
 168 dies_ok {
 169     Class::MOP::Attribute->remove_accessors();
 170 } '... bad remove_accessors argument';
 171
 172 dies_ok {
 173     Class::MOP::Attribute->remove_accessors(bless {} => 'Fail');
 174 } '... bad remove_accessors argument';