t/013_add_attribute_alternate.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Fatal;
   6
   7 use Class::MOP;
   8
   9 {
  10     package Point;
  11     use metaclass;
  12
  13     Point->meta->add_attribute('x' => (
  14         reader   => 'x',
  15         init_arg => 'x'
  16     ));
  17
  18     Point->meta->add_attribute('y' => (
  19         accessor => 'y',
  20         init_arg => 'y'
  21     ));
  22
  23     sub new {
  24         my $class = shift;
  25         bless $class->meta->new_object(@_) => $class;
  26     }
  27
  28     sub clear {
  29         my $self = shift;
  30         $self->{'x'} = 0;
  31         $self->{'y'} = 0;
  32     }
  33
  34     package Point3D;
  35     our @ISA = ('Point');
  36
  37     Point3D->meta->add_attribute('z' => (
  38         default => 123
  39     ));
  40
  41     sub clear {
  42         my $self = shift;
  43         $self->{'z'} = 0;
  44         $self->SUPER::clear();
  45     }
  46 }
  47
  48 isa_ok(Point->meta, 'Class::MOP::Class');
  49 isa_ok(Point3D->meta, 'Class::MOP::Class');
  50
  51 # ... test the classes themselves
  52
  53 my $point = Point->new('x' => 2, 'y' => 3);
  54 isa_ok($point, 'Point');
  55
  56 can_ok($point, 'x');
  57 can_ok($point, 'y');
  58 can_ok($point, 'clear');
  59
  60 {
  61     my $meta = $point->meta;
  62     is($meta, Point->meta(), '... got the meta from the instance too');
  63 }
  64
  65 is($point->y, 3, '... the y attribute was initialized correctly through the metaobject');
  66
  67 $point->y(42);
  68 is($point->y, 42, '... the y attribute was set properly with the accessor');
  69
  70 is($point->x, 2, '... the x attribute was initialized correctly through the metaobject');
  71
  72 ok exception {
  73     $point->x(42);
  74 }, '... cannot write to a read-only accessor';
  75 is($point->x, 2, '... the x attribute was not altered');
  76
  77 $point->clear();
  78
  79 is($point->y, 0, '... the y attribute was cleared correctly');
  80 is($point->x, 0, '... the x attribute was cleared correctly');
  81
  82 my $point3d = Point3D->new('x' => 1, 'y' => 2, 'z' => 3);
  83 isa_ok($point3d, 'Point3D');
  84 isa_ok($point3d, 'Point');
  85
  86 {
  87     my $meta = $point3d->meta;
  88     is($meta, Point3D->meta(), '... got the meta from the instance too');
  89 }
  90
  91 can_ok($point3d, 'x');
  92 can_ok($point3d, 'y');
  93 can_ok($point3d, 'clear');
  94
  95 is($point3d->x, 1, '... the x attribute was initialized correctly through the metaobject');
  96 is($point3d->y, 2, '... the y attribute was initialized correctly through the metaobject');
  97 is($point3d->{'z'}, 3, '... the z attribute was initialized correctly through the metaobject');
  98
  99 {
 100     my $point3d = Point3D->new();
 101     isa_ok($point3d, 'Point3D');
 102
 103     is($point3d->x, undef, '... the x attribute was not initialized');
 104     is($point3d->y, undef, '... the y attribute was not initialized');
 105     is($point3d->{'z'}, 123, '... the z attribute was initialized correctly through the metaobject');
 106
 107 }
 108
 109 done_testing;