t/013_add_attribute_alternate.t

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