#!/usr/bin/perl use strict; use warnings; use Test::More tests => 59; use Test::Exception; use MooseX::Declare; class Point { has 'x' => (isa => 'Int', is => 'rw', required => 1); has 'y' => (isa => 'Int', is => 'rw', required => 1); method clear { $self->x(0); $self->y(0); } } class Point3D extends Point { has 'z' => (isa => 'Int', is => 'rw', required => 1); after clear { $self->z(0); } } my $point = Point->new(x => 1, y => 2); isa_ok($point, 'Point'); isa_ok($point, 'Moose::Object'); is($point->x, 1, '... got the right value for x'); is($point->y, 2, '... got the right value for y'); $point->y(10); is($point->y, 10, '... got the right (changed) value for y'); dies_ok { $point->y('Foo'); } '... cannot assign a non-Int to y'; dies_ok { Point->new(); } '... must provide required attributes to new'; $point->clear(); is($point->x, 0, '... got the right (cleared) value for x'); is($point->y, 0, '... got the right (cleared) value for y'); # check the type constraints on the constructor lives_ok { Point->new(x => 0, y => 0); } '... can assign a 0 to x and y'; dies_ok { Point->new(x => 10, y => 'Foo'); } '... cannot assign a non-Int to y'; dies_ok { Point->new(x => 'Foo', y => 10); } '... cannot assign a non-Int to x'; # Point3D my $point3d = Point3D->new({ x => 10, y => 15, z => 3 }); isa_ok($point3d, 'Point3D'); isa_ok($point3d, 'Point'); isa_ok($point3d, 'Moose::Object'); is($point3d->x, 10, '... got the right value for x'); is($point3d->y, 15, '... got the right value for y'); is($point3d->{'z'}, 3, '... got the right value for z'); $point3d->clear(); is($point3d->x, 0, '... got the right (cleared) value for x'); is($point3d->y, 0, '... got the right (cleared) value for y'); is($point3d->z, 0, '... got the right (cleared) value for z'); dies_ok { Point3D->new(x => 10, y => 'Foo', z => 3); } '... cannot assign a non-Int to y'; dies_ok { Point3D->new(x => 'Foo', y => 10, z => 3); } '... cannot assign a non-Int to x'; dies_ok { Point3D->new(x => 0, y => 10, z => 'Bar'); } '... cannot assign a non-Int to z'; dies_ok { Point3D->new(x => 10, y => 3); } '... z is a required attribute for Point3D'; # test some class introspection can_ok('Point', 'meta'); isa_ok(Point->meta, 'Moose::Meta::Class'); can_ok('Point3D', 'meta'); isa_ok(Point3D->meta, 'Moose::Meta::Class'); isnt(Point->meta, Point3D->meta, '... they are different metaclasses as well'); # poke at Point is_deeply( [ Point->meta->superclasses ], [ 'Moose::Object' ], '... Point got the automagic base class'); my @Point_methods = qw(meta new x y clear DESTROY); my @Point_attrs = ('x', 'y'); is_deeply( [ sort Point->meta->get_method_list() ], [ sort @Point_methods ], '... we match the method list for Point'); is_deeply( [ sort Point->meta->get_attribute_list() ], [ sort @Point_attrs ], '... we match the attribute list for Point'); foreach my $method (@Point_methods) { ok(Point->meta->has_method($method), '... Point has the method "' . $method . '"'); } foreach my $attr_name (@Point_attrs ) { ok(Point->meta->has_attribute($attr_name), '... Point has the attribute "' . $attr_name . '"'); my $attr = Point->meta->get_attribute($attr_name); ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint'); isa_ok($attr->type_constraint, 'Moose::Meta::TypeConstraint'); is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint'); } # poke at Point3D is_deeply( [ Point3D->meta->superclasses ], [ 'Point' ], '... Point3D gets the parent given to it'); my @Point3D_methods = qw(new meta z clear DESTROY); my @Point3D_attrs = ('z'); is_deeply( [ sort Point3D->meta->get_method_list() ], [ sort @Point3D_methods ], '... we match the method list for Point3D'); is_deeply( [ sort Point3D->meta->get_attribute_list() ], [ sort @Point3D_attrs ], '... we match the attribute list for Point3D'); foreach my $method (@Point3D_methods) { ok(Point3D->meta->has_method($method), '... Point3D has the method "' . $method . '"'); } foreach my $attr_name (@Point3D_attrs ) { ok(Point3D->meta->has_attribute($attr_name), '... Point3D has the attribute "' . $attr_name . '"'); my $attr = Point3D->meta->get_attribute($attr_name); ok($attr->has_type_constraint, '... Attribute ' . $attr_name . ' has a type constraint'); isa_ok($attr->type_constraint, 'Moose::Meta::TypeConstraint'); is($attr->type_constraint->name, 'Int', '... Attribute ' . $attr_name . ' has an Int type constraint'); }