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