From: Stevan Little Date: Wed, 23 Jan 2008 15:40:24 +0000 (+0000) Subject: some additional tests for better coverage X-Git-Tag: 0_36^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b99755594809f509bb28edd74cd1f7ae059e66f8;p=gitmo%2FMoose.git some additional tests for better coverage --- diff --git a/Changes b/Changes index f13d620..597f44b 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,21 @@ Revision history for Perl extension Moose +0.36 + * Moose::Role + Moose::Meta::Attribute + - role type tests now support when roles are + applied to non-Moose classes (found by ash) + - added tests for this (thanks to ash) + + * Moose::Meta::Method::Constructor + - improved fix for handling Class::MOP attributes + - added test for this + + * Moose::Meta::Class + - handled the add_attribute($attribute_meta_object) + case correctly + - added test for this + 0.35 Tues. Jan. 22, 2008 * Moose::Meta::Method::Constructor - fix to make sure even Class::MOP attributes diff --git a/MANIFEST b/MANIFEST index 6d4723f..7efd500 100644 --- a/MANIFEST +++ b/MANIFEST @@ -113,6 +113,7 @@ t/030_roles/012_method_exclusion_in_composition.t t/030_roles/013_method_aliasing_in_composition.t t/030_roles/014_more_alias_and_exclude.t t/030_roles/015_runtime_roles_and_attrs.t +t/030_roles/016_runtime_roles_and_nonmoose.t t/030_roles/020_role_composite.t t/030_roles/021_role_composite_exclusion.t t/030_roles/022_role_composition_req_methods.t @@ -168,6 +169,7 @@ t/200_examples/007_Child_Parent_attr_inherit.t t/300_immutable/001_immutable_moose.t t/300_immutable/002_apply_roles_to_immutable.t t/300_immutable/003_immutable_meta_class.t +t/300_immutable/004_inlined_constructors_n_types.t t/400_moose_util/001_moose_util.t t/400_moose_util/002_moose_util_does_role.t t/400_moose_util/003_moose_util_search_class_by_role.t diff --git a/lib/Moose.pm b/lib/Moose.pm index 4191d62..fdfa332 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -4,7 +4,7 @@ package Moose; use strict; use warnings; -our $VERSION = '0.35'; +our $VERSION = '0.36'; our $AUTHORITY = 'cpan:STEVAN'; use Scalar::Util 'blessed', 'reftype'; diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 72e6bd7..50b23a8 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -9,7 +9,7 @@ use Carp 'confess'; use Sub::Name 'subname'; use overload (); -our $VERSION = '0.18'; +our $VERSION = '0.19'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Accessor; @@ -149,13 +149,15 @@ sub _process_options { elsif (exists $options->{does}) { # allow for anon-subtypes here ... if (blessed($options->{does}) && $options->{does}->isa('Moose::Meta::TypeConstraint')) { - $options->{type_constraint} = $options->{isa}; + $options->{type_constraint} = $options->{does}; } else { $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_type_constraint( $options->{does} => { parent => Moose::Util::TypeConstraints::find_type_constraint('Role'), - constraint => sub { $_[0]->does($options->{does}) } + constraint => sub { + Moose::Util::does_role($_[0], $options->{does}) + } } ); } diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 3f927f5..9233d74 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -9,7 +9,7 @@ use Class::MOP; use Carp 'confess'; use Scalar::Util 'weaken', 'blessed', 'reftype'; -our $VERSION = '0.18'; +our $VERSION = '0.19'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Overriden; @@ -278,7 +278,10 @@ sub _apply_all_roles { my %ANON_CLASSES; sub _process_attribute { - my $self = shift; + my $self = shift; + + return $_[0] if blessed $_[0] && $_[0]->isa('Class::MOP::Attribute'); + my $name = shift; my %options = ((scalar @_ == 1 && ref($_[0]) eq 'HASH') ? %{$_[0]} : @_); diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm index c06a651..b6ebe91 100644 --- a/lib/Moose/Meta/Method/Constructor.pm +++ b/lib/Moose/Meta/Method/Constructor.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken', 'looks_like_number'; -our $VERSION = '0.06'; +our $VERSION = '0.07'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method', @@ -92,9 +92,16 @@ sub intialize_body { # which in turn has attributes which are Class::MOP::Attribute # objects, rather than Moose::Meta::Attribute. And # Class::MOP::Attribute attributes have no type constraints. - my @type_constraints = map { $_->type_constraint } grep { $_->can('type_constraint') } @$attrs; + # However we need to make sure we leave an undef value there + # because the inlined code is using the index of the attributes + # to determine where to find the type constraint + + my @type_constraints = map { + $_->can('type_constraint') ? $_->type_constraint : undef + } @$attrs; + my @type_constraint_bodies = map { - $_ && $_->_compiled_type_constraint; + defined $_ ? $_->_compiled_type_constraint : undef; } @type_constraints; $code = eval $source; diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index 6f314b7..c07dc5e 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -11,7 +11,7 @@ use Sub::Name 'subname'; use Data::OptList; use Sub::Exporter; -our $VERSION = '0.07'; +our $VERSION = '0.08'; our $AUTHORITY = 'cpan:STEVAN'; use Moose (); @@ -31,8 +31,8 @@ use Moose::Util::TypeConstraints; # make a subtype for each Moose class subtype $role => as 'Role' - => where { $_->does($role) } - => optimize_as { blessed($_[0]) && $_[0]->can('does') && $_[0]->does($role) } + => where { Moose::Util::does_role($_, $role) } + => optimize_as { blessed($_[0]) && Moose::Util::does_role($_[0], $role) } unless find_type_constraint($role); my $meta; diff --git a/t/020_attributes/005_attribute_does.t b/t/020_attributes/005_attribute_does.t index 06dd05f..8161537 100644 --- a/t/020_attributes/005_attribute_does.t +++ b/t/020_attributes/005_attribute_does.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 8; +use Test::More tests => 10; use Test::Exception; BEGIN { @@ -13,11 +13,16 @@ BEGIN { { package Foo::Role; use Moose::Role; + use Moose::Util::TypeConstraints; # if does() exists on its own, then # we create a type constraint for # it, just as we do for isa() has 'bar' => (is => 'rw', does => 'Bar::Role'); + has 'baz' => ( + is => 'rw', + does => subtype('Role', where { $_->does('Bar::Role') }) + ); package Bar::Role; use Moose::Role; @@ -54,8 +59,18 @@ dies_ok { } '... foo did not pass the type constraint okay'; lives_ok { + $foo->baz($bar); +} '... baz passed the type constraint okay'; + +dies_ok { + $foo->baz($foo); +} '... foo did not pass the type constraint okay'; + +lives_ok { $bar->foo($foo); -} '... foo passed the type constraint okay'; +} '... foo passed the type constraint okay'; + + # some error conditions diff --git a/t/020_attributes/009_attribute_inherited_slot_specs.t b/t/020_attributes/009_attribute_inherited_slot_specs.t index 02b52fb..2f1151f 100644 --- a/t/020_attributes/009_attribute_inherited_slot_specs.t +++ b/t/020_attributes/009_attribute_inherited_slot_specs.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 80; +use Test::More tests => 84; use Test::Exception; BEGIN { @@ -40,6 +40,8 @@ BEGIN { has 'blang' => (is => 'ro', isa => 'Thing', handles => ['goodbye']); has 'bunch_of_stuff' => (is => 'rw', isa => 'ArrayRef'); + + has 'one_last_one' => (is => 'rw', isa => 'Ref'); # this one will work here .... has 'fail' => (isa => 'CodeRef'); @@ -47,6 +49,7 @@ BEGIN { package Bar; use Moose; + use Moose::Util::TypeConstraints; extends 'Foo'; @@ -75,6 +78,14 @@ BEGIN { } '... extend an attribute with parameterized type'; ::lives_ok { + has '+one_last_one' => (isa => subtype('Ref', where { blessed $_ eq 'CODE' })); + } '... extend an attribute with anon-subtype'; + + ::dies_ok { + has '+one_last_one' => (isa => 'Value'); + } '... cannot extend an attribute with a non-subtype'; + + ::lives_ok { has '+bling' => (handles => ['hello']); } '... we can add the handles attribute option'; @@ -90,7 +101,10 @@ BEGIN { } '... cannot create an attribute with an illegal option'; ::dies_ok { has '+other_fail' => (weak_ref => 1); - } '... cannot create an attribute with an illegal option'; + } '... cannot create an attribute with an illegal option'; + ::dies_ok { + has '+other_fail' => (isa => 'WangDoodle'); + } '... cannot create an attribute with a non-existent type'; } @@ -123,6 +137,8 @@ is($foo->baz, undef, '... got the right undef default value'); lives_ok { $foo->bunch_of_stuff([qw[one two three]]) } '... Foo::bunch_of_stuff accepts an array of strings'; + lives_ok { $foo->one_last_one(sub { 'Hello World'}) } '... Foo::one_last_one accepts a code ref'; + my $code_ref = sub { 1 }; lives_ok { $foo->baz($code_ref) } '... Foo::baz accepts a code ref'; is($foo->baz, $code_ref, '... got the right value assigned to baz'); diff --git a/t/020_attributes/012_misc_attribute_tests.t b/t/020_attributes/012_misc_attribute_tests.t index 2d7e1d0..d25d1c8 100644 --- a/t/020_attributes/012_misc_attribute_tests.t +++ b/t/020_attributes/012_misc_attribute_tests.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 41; +use Test::More tests => 42; use Test::Exception; BEGIN { @@ -162,6 +162,18 @@ BEGIN { is($instance->foo, 'works', "foo builder works"); } +{ + { + package Test::Builder::Attribute::Broken; + use Moose; + + has 'foo' => ( required => 1, builder => 'build_foo', is => 'ro'); + } + + dies_ok { + Test::Builder::Attribute::Broken->new; + } '... no builder, wtf'; +} { diff --git a/t/030_roles/016_runtime_roles_and_nonmoose.t b/t/030_roles/016_runtime_roles_and_nonmoose.t index 706018d..056aef7 100644 --- a/t/030_roles/016_runtime_roles_and_nonmoose.t +++ b/t/030_roles/016_runtime_roles_and_nonmoose.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 7; +use Test::More tests => 8; use Test::Exception; use Scalar::Util 'blessed'; @@ -35,24 +35,25 @@ BEGIN { } } -my $obj = Bar->new; -isa_ok($obj, 'Bar'); +my $bar = Bar->new; +isa_ok($bar, 'Bar'); my $foo = Foo->new; +isa_ok($foo, 'Foo'); -ok(!$obj->can( 'talk' ), "... the role is not composed yet"); +ok(!$bar->can( 'talk' ), "... the role is not composed yet"); dies_ok { - $foo->dog($obj) + $foo->dog($bar) } '... and setting the accessor fails (not a Dog yet)'; -Dog->meta->apply($obj); +Dog->meta->apply($bar); -ok($obj->can('talk'), "... the role is now composed at the object level"); +ok($bar->can('talk'), "... the role is now composed at the object level"); -is($obj->talk, 'woof', '... got the right return value for the newly composed method'); +is($bar->talk, 'woof', '... got the right return value for the newly composed method'); lives_ok { - $foo->dog($obj) + $foo->dog($bar) } '... and setting the accessor is okay'; diff --git a/t/300_immutable/004_inlined_constructors_n_types.t b/t/300_immutable/004_inlined_constructors_n_types.t new file mode 100644 index 0000000..54b3c66 --- /dev/null +++ b/t/300_immutable/004_inlined_constructors_n_types.t @@ -0,0 +1,50 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 3; +use Test::Exception; + +BEGIN { + use_ok('Moose'); +} + +=pod + +This tests to make sure that the inlined constructor +has all the type constraints in order, even in the +cases when there is no type constraint available, such +as with a Class::MOP::Attribute object. + +=cut + +{ + package Foo; + use Moose; + + has 'foo' => (is => 'rw', isa => 'Int'); + has 'baz' => (is => 'rw', isa => 'Int'); + + Foo->meta->add_attribute( + Class::MOP::Attribute->new( + 'bar' => ( + accessor => 'bar', + ) + ) + ); + + Foo->meta->make_immutable(debug => 0); +} + +lives_ok { + Foo->new(foo => 10, bar => "Hello World", baz => 10); +} '... this passes the constuctor correctly'; + +dies_ok { + Foo->new(foo => "Hello World", bar => 100, baz => "Hello World"); +} '... this fails the constuctor correctly'; + + + +