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