t/021_attribute_errors_and_edge_cases.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   6
   7 use Class::MOP;
   8 use Class::MOP::Attribute;
   9
  10 # most values are static
  11
  12 {
  13     dies_ok {
  14         Class::MOP::Attribute->new('$test' => (
  15             default => qr/hello (.*)/
  16         ));
  17     } '... no refs for defaults';
  18
  19     dies_ok {
  20         Class::MOP::Attribute->new('$test' => (
  21             default => []
  22         ));
  23     } '... no refs for defaults';
  24
  25     dies_ok {
  26         Class::MOP::Attribute->new('$test' => (
  27             default => {}
  28         ));
  29     } '... no refs for defaults';
  30
  31
  32     dies_ok {
  33         Class::MOP::Attribute->new('$test' => (
  34             default => \(my $var)
  35         ));
  36     } '... no refs for defaults';
  37
  38     dies_ok {
  39         Class::MOP::Attribute->new('$test' => (
  40             default => bless {} => 'Foo'
  41         ));
  42     } '... no refs for defaults';
  43
  44 }
  45
  46 {
  47     dies_ok {
  48         Class::MOP::Attribute->new('$test' => (
  49             builder => qr/hello (.*)/
  50         ));
  51     } '... no refs for builders';
  52
  53     dies_ok {
  54         Class::MOP::Attribute->new('$test' => (
  55             builder => []
  56         ));
  57     } '... no refs for builders';
  58
  59     dies_ok {
  60         Class::MOP::Attribute->new('$test' => (
  61             builder => {}
  62         ));
  63     } '... no refs for builders';
  64
  65
  66     dies_ok {
  67         Class::MOP::Attribute->new('$test' => (
  68             builder => \(my $var)
  69         ));
  70     } '... no refs for builders';
  71
  72     dies_ok {
  73         Class::MOP::Attribute->new('$test' => (
  74             builder => bless {} => 'Foo'
  75         ));
  76     } '... no refs for builders';
  77
  78     dies_ok {
  79         Class::MOP::Attribute->new('$test' => (
  80             builder => 'Foo', default => 'Foo'
  81         ));
  82     } '... no default AND builder';
  83
  84     my $undef_attr;
  85     lives_ok {
  86         $undef_attr = Class::MOP::Attribute->new('$test' => (
  87             default   => undef,
  88             predicate => 'has_test',
  89         ));
  90     } '... undef as a default is okay';
  91     ok($undef_attr->has_default, '... and it counts as an actual default');
  92     ok(!Class::MOP::Attribute->new('$test')->has_default,
  93        '... but attributes with no default have no default');
  94
  95     Class::MOP::Class->create(
  96         'Foo',
  97         attributes => [$undef_attr],
  98     );
  99     {
 100         my $obj = Foo->meta->new_object;
 101         ok($obj->has_test, '... and the default is populated');
 102         is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
 103     }
 104     lives_ok { Foo->meta->make_immutable }
 105              '... and it can be inlined';
 106     {
 107         my $obj = Foo->new;
 108         ok($obj->has_test, '... and the default is populated');
 109         is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
 110     }
 111
 112 }
 113
 114
 115 { # bad construtor args
 116     dies_ok {
 117         Class::MOP::Attribute->new();
 118     } '... no name argument';
 119
 120     # These are no longer errors
 121     lives_ok {
 122         Class::MOP::Attribute->new('');
 123     } '... bad name argument';
 124
 125     lives_ok {
 126         Class::MOP::Attribute->new(0);
 127     } '... bad name argument';
 128 }
 129
 130 {
 131     my $attr = Class::MOP::Attribute->new('$test');
 132     dies_ok {
 133         $attr->attach_to_class();
 134     } '... attach_to_class died as expected';
 135
 136     dies_ok {
 137         $attr->attach_to_class('Fail');
 138     } '... attach_to_class died as expected';
 139
 140     dies_ok {
 141         $attr->attach_to_class(bless {} => 'Fail');
 142     } '... attach_to_class died as expected';
 143 }
 144
 145 {
 146     my $attr = Class::MOP::Attribute->new('$test' => (
 147         reader => [ 'whoops, this wont work' ]
 148     ));
 149
 150     $attr->attach_to_class(Class::MOP::Class->initialize('Foo'));
 151
 152     dies_ok {
 153         $attr->install_accessors;
 154     } '... bad reader format';
 155 }
 156
 157 {
 158     my $attr = Class::MOP::Attribute->new('$test');
 159
 160     dies_ok {
 161         $attr->_process_accessors('fail', 'my_failing_sub');
 162     } '... cannot find "fail" type generator';
 163 }
 164
 165
 166 {
 167     {
 168         package My::Attribute;
 169         our @ISA = ('Class::MOP::Attribute');
 170         sub generate_reader_method { eval { die } }
 171     }
 172
 173     my $attr = My::Attribute->new('$test' => (
 174         reader => 'test'
 175     ));
 176
 177     dies_ok {
 178         $attr->install_accessors;
 179     } '... failed to generate accessors correctly';
 180 }
 181
 182 {
 183     my $attr = Class::MOP::Attribute->new('$test' => (
 184         predicate => 'has_test'
 185     ));
 186
 187     my $Bar = Class::MOP::Class->create('Bar');
 188     isa_ok($Bar, 'Class::MOP::Class');
 189
 190     $Bar->add_attribute($attr);
 191
 192     can_ok('Bar', 'has_test');
 193
 194     is($attr, $Bar->remove_attribute('$test'), '... removed the $test attribute');
 195
 196     ok(!Bar->can('has_test'), '... Bar no longer has the "has_test" method');
 197 }
 198
 199
 200 {
 201     # NOTE:
 202     # the next three tests once tested that
 203     # the code would fail, but we lifted the
 204     # restriction so you can have an accessor
 205     # along with a reader/writer pair (I mean
 206     # why not really). So now they test that
 207     # it works, which is kinda silly, but it
 208     # tests the API change, so I keep it.
 209
 210     lives_ok {
 211         Class::MOP::Attribute->new('$foo', (
 212             accessor => 'foo',
 213             reader   => 'get_foo',
 214         ));
 215     } '... can create accessors with reader/writers';
 216
 217     lives_ok {
 218         Class::MOP::Attribute->new('$foo', (
 219             accessor => 'foo',
 220             writer   => 'set_foo',
 221         ));
 222     } '... can create accessors with reader/writers';
 223
 224     lives_ok {
 225         Class::MOP::Attribute->new('$foo', (
 226             accessor => 'foo',
 227             reader   => 'get_foo',
 228             writer   => 'set_foo',
 229         ));
 230     } '... can create accessors with reader/writers';
 231 }
 232
 233 done_testing;