t/001_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 32;
   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' => (reader   => 'x');
  20         has '$.y' => (accessor => 'y');
  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';
  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 $point->x(1000);
  55 is($point->x, 1, '... got the right (un-changed) value for x');
  56
  57 $point->clear();
  58
  59 is($point->x, 0, '... got the right (cleared) value for x');
  60 is($point->y, 0, '... got the right (cleared) value for y');
  61
  62 my $point3d = Point3D->new(x => 10, y => 15, z => 3);
  63 isa_ok($point3d, 'Point3D');
  64 isa_ok($point3d, 'Point');
  65 isa_ok($point3d, 'Moose::Object');
  66
  67 is($point3d->x, 10, '... got the right value for x');
  68 is($point3d->y, 15, '... got the right value for y');
  69 is($point3d->{'$:z'}, 3, '... got the right value for z');
  70
  71 dies_ok {
  72         $point3d->z;
  73 } '... there is no method for z';
  74
  75 $point3d->clear();
  76
  77 is($point3d->x, 0, '... got the right (cleared) value for x');
  78 is($point3d->y, 0, '... got the right (cleared) value for y');
  79 is($point3d->{'$:z'}, 0, '... got the right (cleared) value for z');
  80
  81 # test some class introspection
  82
  83 can_ok('Point', 'meta');
  84 isa_ok(Point->meta, 'Moose::Meta::Class');
  85
  86 can_ok('Point3D', 'meta');
  87 isa_ok(Point3D->meta, 'Moose::Meta::Class');
  88
  89 isnt(Point->meta, Point3D->meta, '... they are different metaclasses as well');
  90
  91 # poke at Point
  92
  93 is_deeply(
  94         [ Point->meta->superclasses ],
  95         [ 'Moose::Object' ],
  96         '... Point got the automagic base class');
  97
  98 my @Point_methods = qw(x y clear);
  99
 100 is_deeply(
 101         [ sort @Point_methods                 ],
 102         [ sort Point->meta->get_method_list() ],
 103         '... we match the method list for Point');
 104
 105 foreach my $method (@Point_methods) {
 106         ok(Point->meta->has_method($method), '... Point has the method "' . $method . '"');
 107 }
 108
 109 # poke at Point3D
 110
 111 is_deeply(
 112         [ Point3D->meta->superclasses ],
 113         [ 'Point' ],
 114         '... Point3D gets the parent given to it');
 115
 116 my @Point3D_methods = qw(clear);
 117
 118 is_deeply(
 119         [ sort @Point3D_methods                 ],
 120         [ sort Point3D->meta->get_method_list() ],
 121         '... we match the method list for Point3D');
 122
 123 foreach my $method (@Point3D_methods) {
 124         ok(Point3D->meta->has_method($method), '... Point3D has the method "' . $method . '"');
 125 }
 126
 127