trAvis - MANAGER
Edit File: basics_point_attributesandsubclassing.t
#!/usr/bin/perl -w use strict; use Test::More 'no_plan'; use Test::Fatal; $| = 1; # =begin testing SETUP { package Point; use Moose; has 'x' => (isa => 'Int', is => 'rw', required => 1); has 'y' => (isa => 'Int', is => 'rw', required => 1); sub clear { my $self = shift; $self->x(0); $self->y(0); } package Point3D; use Moose; extends 'Point'; has 'z' => (isa => 'Int', is => 'rw', required => 1); after 'clear' => sub { my $self = shift; $self->z(0); }; package main; # hash or hashrefs are ok for the constructor my $point1 = Point->new(x => 5, y => 7); my $point2 = Point->new({x => 5, y => 7}); my $point3d = Point3D->new(x => 5, y => 42, z => -5); } # =begin testing { 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' ); isnt( exception { $point->y('Foo'); }, undef, '... cannot assign a non-Int to y' ); isnt( exception { Point->new(); }, undef, '... 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 is( exception { Point->new( x => 0, y => 0 ); }, undef, '... can assign a 0 to x and y' ); isnt( exception { Point->new( x => 10, y => 'Foo' ); }, undef, '... cannot assign a non-Int to y' ); isnt( exception { Point->new( x => 'Foo', y => 10 ); }, undef, '... 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' ); isnt( exception { Point3D->new( x => 10, y => 'Foo', z => 3 ); }, undef, '... cannot assign a non-Int to y' ); isnt( exception { Point3D->new( x => 'Foo', y => 10, z => 3 ); }, undef, '... cannot assign a non-Int to x' ); isnt( exception { Point3D->new( x => 0, y => 10, z => 'Bar' ); }, undef, '... cannot assign a non-Int to z' ); isnt( exception { Point3D->new( x => 10, y => 3 ); }, undef, '... 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 x y clear); my @Point_attrs = ( 'x', 'y' ); is_deeply( [ sort @Point_methods ], [ sort Point->meta->get_method_list() ], '... we match the method list for Point' ); is_deeply( [ sort @Point_attrs ], [ sort Point->meta->get_attribute_list() ], '... 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( meta z clear ); my @Point3D_attrs = ('z'); is_deeply( [ sort @Point3D_methods ], [ sort Point3D->meta->get_method_list() ], '... we match the method list for Point3D' ); is_deeply( [ sort @Point3D_attrs ], [ sort Point3D->meta->get_attribute_list() ], '... 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' ); } } 1;