t/021_attribute_errors_and_edge_cases.t

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