t/000_recipes/001_recipe.t

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