t/001_recipe.t

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