From: Stevan Little Date: Wed, 19 Apr 2006 17:43:57 +0000 (+0000) Subject: tests X-Git-Tag: 0_05~20 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7eaef7ad987c89e849c8d55fe718c5db617b55df;p=gitmo%2FMoose.git tests --- diff --git a/Changes b/Changes index 8da8df4..9f02222 100644 --- a/Changes +++ b/Changes @@ -12,6 +12,8 @@ Revision history for Perl extension Moose - added Bool type and CollectionRef type then made ArrayRef and HashRef into subtypes of the CollectionRef + - keywords are now exported with Sub::Exporter + thanks chansen for this commit 0.04 Sun. April 16th, 2006 * Moose::Role diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 4ceab19..d0b1086 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -37,7 +37,7 @@ sub new { } elsif ($options{is} eq 'rw') { $options{accessor} = $name; - (reftype($options{trigger}) eq 'CODE') + ((reftype($options{trigger}) || '') eq 'CODE') || confess "A trigger must be a CODE reference" if exists $options{trigger}; } @@ -50,6 +50,9 @@ sub new { ($options{isa}->does($options{does})) || confess "Cannot have an isa option and a does option if the isa does not do the does"; } + else { + confess "Cannot have an isa option which cannot ->does()"; + } } # allow for anon-subtypes here ... diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index 5299a79..9671f3a 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -13,27 +13,34 @@ use Sub::Exporter; our $VERSION = '0.03'; use Moose::Meta::Role; +use Moose::Util::TypeConstraints; { my ( $CALLER, %METAS ); sub _find_meta { - my $class = $CALLER; + my $role = $CALLER; - return $METAS{$class} if exists $METAS{$class}; + return $METAS{$role} if exists $METAS{$role}; + + # make a subtype for each Moose class + subtype $role + => as 'Role' + => where { $_->does($role) } + unless find_type_constraint($role); my $meta; - if ($class->can('meta')) { - $meta = $class->meta(); + if ($role->can('meta')) { + $meta = $role->meta(); (blessed($meta) && $meta->isa('Moose::Meta::Role')) || confess "Whoops, not møøsey enough"; } else { - $meta = Moose::Meta::Role->new(role_name => $class); + $meta = Moose::Meta::Role->new(role_name => $role); $meta->_role_meta->add_method('meta' => sub { $meta }) } - return $METAS{$class} = $meta; + return $METAS{$role} = $meta; } diff --git a/t/011_require_superclasses.t b/t/011_require_superclasses.t index beacd42..3925cf4 100644 --- a/t/011_require_superclasses.t +++ b/t/011_require_superclasses.t @@ -5,7 +5,7 @@ use warnings; use lib 't/lib', 'lib'; -use Test::More tests => 4; +use Test::More tests => 6; BEGIN { use_ok('Moose'); @@ -41,3 +41,14 @@ BEGIN { ::ok(!$@, '... loaded Foo and (inline) Bar superclass correctly'); } +{ + package Bling; + use strict; + use warnings; + use Moose; + + eval { extends 'No::Class'; }; + ::ok($@, '... could not find the superclass (as expected)'); + ::like($@, qr/^Could not load superclass 'No\:\:Class' because \:/, '... and got the error we expected'); +} + diff --git a/t/021_moose_w_metaclass.t b/t/021_moose_w_metaclass.t new file mode 100644 index 0000000..f71258f --- /dev/null +++ b/t/021_moose_w_metaclass.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 5; +use Test::Exception; + +BEGIN { + use_ok('Moose'); +} + + +{ + package Foo::Meta; + use strict; + use warnings; + + use base 'Moose::Meta::Class'; + + package Foo; + use strict; + use warnings; + use metaclass 'Foo::Meta'; + ::use_ok('Moose'); +} + +isa_ok(Foo->meta, 'Foo::Meta'); + +{ + package Bar::Meta; + use strict; + use warnings; + + use base 'Class::MOP::Class'; + + package Bar; + use strict; + use warnings; + use metaclass 'Bar::Meta'; + eval 'use Moose;'; + ::ok($@, '... could not load moose without correct metaclass'); + ::like($@, qr/^Whoops\, not møøsey enough/, '... got the right error too'); +} diff --git a/t/022_moose_respects_base.t b/t/022_moose_respects_base.t new file mode 100644 index 0000000..5c96175 --- /dev/null +++ b/t/022_moose_respects_base.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 3; +use Test::Exception; + +BEGIN { + use_ok('Moose'); +} + +{ + package Foo; + use strict; + use warnings; + + sub foo { 'Foo::foo' } + + package Bar; + use strict; + use warnings; + use Moose; + + use base 'Foo'; +} + +my $bar = Bar->new; +isa_ok($bar, 'Bar'); +isa_ok($bar, 'Foo'); \ No newline at end of file diff --git a/t/033_attribute_triggers.t b/t/033_attribute_triggers.t index 66b0861..361bf4f 100644 --- a/t/033_attribute_triggers.t +++ b/t/033_attribute_triggers.t @@ -5,7 +5,7 @@ use warnings; use Scalar::Util 'isweak'; -use Test::More tests => 24; +use Test::More tests => 27; use Test::Exception; BEGIN { @@ -108,3 +108,32 @@ BEGIN { ok(isweak($baz->{foo}), '... baz.foo is a weak reference'); } +# some errors + +{ + package Bling; + use strict; + use warnings; + use Moose; + + ::dies_ok { + has('bling' => (is => 'ro', trigger => sub { 0 })); + } '... cannot create trigger on a read-only attr'; +} + +{ + package Bling::Bling; + use strict; + use warnings; + use Moose; + + ::dies_ok { + has('bling' => (is => 'rw', trigger => 'Fail')); + } '... a trigger must be a CODE ref'; + + ::dies_ok { + has('bling' => (is => 'rw', trigger => [])); + } '... a trigger must be a CODE ref'; +} + + diff --git a/t/034_does_attribute_option.t b/t/034_attribute_does.t similarity index 77% rename from t/034_does_attribute_option.t rename to t/034_attribute_does.t index a154f93..f95360f 100644 --- a/t/034_does_attribute_option.t +++ b/t/034_attribute_does.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 7; +use Test::More tests => 8; use Test::Exception; BEGIN { @@ -79,4 +79,25 @@ lives_ok { has 'foo' => (isa => 'Foo::Class', does => 'Bar::Class'); } '... cannot have a does() which is not done by the isa()'; } + +{ + package Bling; + use strict; + use warnings; + + sub bling { 'Bling::bling' } + + package Bling::Bling; + use strict; + use warnings; + use Moose; + + # if isa and does appear together, then see if Class->does(Role) + # if it does not,.. we have a conflict... so we die loudly + ::dies_ok { + has 'foo' => (isa => 'Bling', does => 'Bar::Class'); + } '... cannot have a isa() which is cannot does()'; +} + +