t/000_recipes/basics/001_point.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 57;
   7 use Test::Exception;
   8
   9 {
  10     package Point;
  11     use Moose;
  12
  13     has 'x' => (isa => 'Int', is => 'rw', required => 1);
  14     has 'y' => (isa => 'Int', is => 'rw', required => 1);
  15
  16     sub clear {
  17         my $self = shift;
  18         $self->x(0);
  19         $self->y(0);
  20     }
  21
  22     __PACKAGE__->meta->make_immutable( debug => 0 );
  23 }
  24
  25 {
  26     package Point3D;
  27     use Moose;
  28
  29     extends 'Point';
  30
  31     has 'z' => (isa => 'Int', is => 'rw', required => 1);
  32
  33     after 'clear' => sub {
  34         my $self = shift;
  35         $self->z(0);
  36     };
  37
  38     __PACKAGE__->meta->make_immutable( debug => 0 );
  39 }
  40
  41 my $point = Point->new(x => 1, y => 2);
  42 isa_ok($point, 'Point');
  43 isa_ok($point, 'Moose::Object');
  44
  45 is($point->x, 1, '... got the right value for x');
  46 is($point->y, 2, '... got the right value for y');
  47
  48 $point->y(10);
  49 is($point->y, 10, '... got the right (changed) value for y');
  50
  51 dies_ok {
  52         $point->y('Foo');
  53 } '... cannot assign a non-Int to y';
  54
  55 dies_ok {
  56     Point->new();
  57 } '... must provide required attributes to new';
  58
  59 $point->clear();
  60
  61 is($point->x, 0, '... got the right (cleared) value for x');
  62 is($point->y, 0, '... got the right (cleared) value for y');
  63
  64 # check the type constraints on the constructor
  65
  66 lives_ok {
  67         Point->new(x => 0, y => 0);
  68 } '... can assign a 0 to x and y';
  69
  70 dies_ok {
  71         Point->new(x => 10, y => 'Foo');
  72 } '... cannot assign a non-Int to y';
  73
  74 dies_ok {
  75         Point->new(x => 'Foo', y => 10);
  76 } '... cannot assign a non-Int to x';
  77
  78 # Point3D
  79
  80 my $point3d = Point3D->new({ x => 10, y => 15, z => 3 });
  81 isa_ok($point3d, 'Point3D');
  82 isa_ok($point3d, 'Point');
  83 isa_ok($point3d, 'Moose::Object');
  84
  85 is($point3d->x, 10, '... got the right value for x');
  86 is($point3d->y, 15, '... got the right value for y');
  87 is($point3d->{'z'}, 3, '... got the right value for z');
  88
  89 $point3d->clear();
  90
  91 is($point3d->x, 0, '... got the right (cleared) value for x');
  92 is($point3d->y, 0, '... got the right (cleared) value for y');
  93 is($point3d->z, 0, '... got the right (cleared) value for z');
  94
  95 dies_ok {
  96         Point3D->new(x => 10, y => 'Foo', z => 3);
  97 } '... cannot assign a non-Int to y';
  98
  99 dies_ok {
 100         Point3D->new(x => 'Foo', y => 10, z => 3);
 101 } '... cannot assign a non-Int to x';
 102
 103 dies_ok {
 104         Point3D->new(x => 0, y => 10, z => 'Bar');
 105 } '... cannot assign a non-Int to z';
 106
 107 dies_ok {
 108         Point3D->new(x => 10, y => 3);
 109 } '... z is a required attribute for Point3D';
 110
 111 # test some class introspection
 112
 113 can_ok('Point', 'meta');
 114 isa_ok(Point->meta, 'Moose::Meta::Class');
 115
 116 can_ok('Point3D', 'meta');
 117 isa_ok(Point3D->meta, 'Moose::Meta::Class');
 118
 119 isnt(Point->meta, Point3D->meta, '... they are different metaclasses as well');
 120
 121 # poke at Point
 122
 123 is_deeply(
 124         [ Point->meta->superclasses ],
 125         [ 'Moose::Object' ],
 126         '... Point got the automagic base class');
 127
 128 my @Point_methods = qw(meta new x y clear);
 129 my @Point_attrs   = ('x', 'y');
 130
 131 is_deeply(
 132         [ sort @Point_methods                 ],
 133         [ sort Point->meta->get_method_list() ],
 134         '... we match the method list for Point');
 135
 136 is_deeply(
 137         [ sort @Point_attrs                      ],
 138         [ sort Point->meta->get_attribute_list() ],
 139         '... we match the attribute list for Point');
 140
 141 foreach my $method (@Point_methods) {
 142         ok(Point->meta->has_method($method), '... Point has the method "' . $method . '"');
 143 }
 144
 145 foreach my $attr_name (@Point_attrs ) {
 146         ok(Point->meta->has_attribute($attr_name), '... Point has the attribute "' . $attr_name . '"');
 147     my $attr = Point->meta->get_attribute($attr_name);
 148         ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint');
 149         isa_ok($attr->type_constraint, 'Moose::Meta::TypeConstraint');
 150     is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint');
 151 }
 152
 153 # poke at Point3D
 154
 155 is_deeply(
 156         [ Point3D->meta->superclasses ],
 157         [ 'Point' ],
 158         '... Point3D gets the parent given to it');
 159
 160 my @Point3D_methods = qw(new meta z clear);
 161 my @Point3D_attrs   = ('z');
 162
 163 is_deeply(
 164         [ sort @Point3D_methods                 ],
 165         [ sort Point3D->meta->get_method_list() ],
 166         '... we match the method list for Point3D');
 167
 168 is_deeply(
 169         [ sort @Point3D_attrs                      ],
 170         [ sort Point3D->meta->get_attribute_list() ],
 171         '... we match the attribute list for Point3D');
 172
 173 foreach my $method (@Point3D_methods) {
 174         ok(Point3D->meta->has_method($method), '... Point3D has the method "' . $method . '"');
 175 }
 176
 177 foreach my $attr_name (@Point3D_attrs ) {
 178         ok(Point3D->meta->has_attribute($attr_name), '... Point3D has the attribute "' . $attr_name . '"');
 179     my $attr = Point3D->meta->get_attribute($attr_name);
 180         ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint');
 181         isa_ok($attr->type_constraint, 'Moose::Meta::TypeConstraint');
 182     is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint');
 183 }