t/001_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 41;
   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' => (
  20                 is => Int(),
  21                 reader => 'x',
  22         );
  23
  24         has 'y' => (
  25                 is => Int(),
  26                 accessor => 'y',
  27         );
  28
  29         sub clear {
  30             my $self = shift;
  31             $self->{x} = 0;
  32             $self->y(0);
  33         }
  34
  35         package Point3D;
  36         use strict;
  37         use warnings;
  38         use Moose;
  39
  40         extends 'Point';
  41
  42         has 'z' => (is => 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, 'Moose::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 $point->x(1000);
  66 is($point->x, 1, '... got the right (un-changed) value for x');
  67
  68 $point->clear();
  69
  70 is($point->x, 0, '... got the right (cleared) value for x');
  71 is($point->y, 0, '... got the right (cleared) value for y');
  72
  73 # check the type constraints on the constructor
  74
  75 lives_ok {
  76         Point->new(x => 0, y => 0);
  77 } '... can assign a 0 to x and y';
  78
  79 dies_ok {
  80         Point->new(x => 10, y => 'Foo');
  81 } '... cannot assign a non-Int to y';
  82
  83 dies_ok {
  84         Point->new(x => 'Foo', y => 10);
  85 } '... cannot assign a non-Int to x';
  86
  87 # Point3D
  88
  89 my $point3d = Point3D->new(x => 10, y => 15, z => 3);
  90 isa_ok($point3d, 'Point3D');
  91 isa_ok($point3d, 'Point');
  92 isa_ok($point3d, 'Moose::Object');
  93
  94 is($point3d->x, 10, '... got the right value for x');
  95 is($point3d->y, 15, '... got the right value for y');
  96 is($point3d->{'z'}, 3, '... got the right value for z');
  97
  98 dies_ok {
  99         $point3d->z;
 100 } '... there is no method for z';
 101
 102 $point3d->clear();
 103
 104 is($point3d->x, 0, '... got the right (cleared) value for x');
 105 is($point3d->y, 0, '... got the right (cleared) value for y');
 106 is($point3d->{'z'}, 0, '... got the right (cleared) value for z');
 107
 108 dies_ok {
 109         Point3D->new(x => 10, y => 'Foo', z => 3);
 110 } '... cannot assign a non-Int to y';
 111
 112 dies_ok {
 113         Point3D->new(x => 'Foo', y => 10, z => 3);
 114 } '... cannot assign a non-Int to x';
 115
 116 dies_ok {
 117         Point3D->new(x => 0, y => 10, z => 'Bar');
 118 } '... cannot assign a non-Int to z';
 119
 120 # test some class introspection
 121
 122 can_ok('Point', 'meta');
 123 isa_ok(Point->meta, 'Moose::Meta::Class');
 124
 125 can_ok('Point3D', 'meta');
 126 isa_ok(Point3D->meta, 'Moose::Meta::Class');
 127
 128 isnt(Point->meta, Point3D->meta, '... they are different metaclasses as well');
 129
 130 # poke at Point
 131
 132 is_deeply(
 133         [ Point->meta->superclasses ],
 134         [ 'Moose::Object' ],
 135         '... Point got the automagic base class');
 136
 137 my @Point_methods = qw(x y clear);
 138 my @Point_attrs   = ('x', 'y');
 139
 140 is_deeply(
 141         [ sort @Point_methods                 ],
 142         [ sort Point->meta->get_method_list() ],
 143         '... we match the method list for Point');
 144
 145 is_deeply(
 146         [ sort @Point_attrs                      ],
 147         [ sort Point->meta->get_attribute_list() ],
 148         '... we match the attribute list for Point');
 149
 150 foreach my $method (@Point_methods) {
 151         ok(Point->meta->has_method($method), '... Point has the method "' . $method . '"');
 152 }
 153
 154 # poke at Point3D
 155
 156 is_deeply(
 157         [ Point3D->meta->superclasses ],
 158         [ 'Point' ],
 159         '... Point3D gets the parent given to it');
 160
 161 my @Point3D_methods = qw(clear);
 162 my @Point3D_attrs   = ('z');
 163
 164 is_deeply(
 165         [ sort @Point3D_methods                 ],
 166         [ sort Point3D->meta->get_method_list() ],
 167         '... we match the method list for Point3D');
 168
 169 is_deeply(
 170         [ sort @Point3D_attrs                      ],
 171         [ sort Point3D->meta->get_attribute_list() ],
 172         '... we match the attribute list for Point3D');
 173
 174 foreach my $method (@Point3D_methods) {
 175         ok(Point3D->meta->has_method($method), '... Point3D has the method "' . $method . '"');
 176 }