t/000-recipes/001_point.t

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