...
[23:49] mst oh, also: method 'has' => sub { ... } could squelch the redefine warning
+- Role excludes
+
+[17:00] stevan I am reading the new Fortress Spec
+[17:00] stevan http://research.sun.com/projects/plrg/fortress0903.pdf
+[17:00] stevan they have traits too
+[17:01] stevan and they have one cool feature which we might want to steal
+[17:01] stevan traits can "exclude" other traits
+[17:01] stevan which means they cannot be combined with other classes/roles which does() that trait
+[17:01] stevan the example they give is
+[17:01] stevan trait OrganicMolecule extends Molecule
+[17:01] stevan excludes { InorganicMolecule }
+[17:01] stevan end
+[17:01] stevan trait InorganicMolecule extends Molecule
+[17:01] stevan end
+[17:01] stevan this creates a set of mutually exclusive traits
+[17:02] stevan so that this:
+[17:02] stevan trait ScienceGoo extends { OrganicMolecule, InorganicMolocule } end
+[17:02] stevan would fail
+[17:02] stevan because OrganicMolecule, InorganicMolocule can never be used together
+[17:03] stevan I am thinking this is quite sane
+
-------------------------------------------------------------------------------
TO PONDER
-------------------------------------------------------------------------------
sub add_override_method_modifier {
my ($self, $name, $method, $_super_package) = @_;
+ (!$self->has_method($name))
+ || confess "Cannot add an override method if a local method is already present";
# need this for roles ...
$_super_package ||= $self->name;
my $super = $self->find_next_method_by_name($name);
sub add_augment_method_modifier {
my ($self, $name, $method) = @_;
+ (!$self->has_method($name))
+ || confess "Cannot add an augment method if a local method is already present";
my $super = $self->find_next_method_by_name($name);
(defined $super)
|| confess "You cannot augment '$name' because it has no super method";
# see if we are being composed
# into a role or not
if ($other->isa('Moose::Meta::Role')) {
+
+ # FIXME:
+ # it is possible for these attributes
+ # to actually both be from the same
+ # origin (some common ancestor role)
+ # so we need to find a way to check this
+
# all attribute conflicts between roles
# result in an immediate fatal error
confess "Role '" . $self->name . "' has encountered an attribute conflict " .
}
foreach my $method_name ($self->get_method_modifier_list('override')) {
- # skip it if it has one already
- next if $other->has_method($method_name);
- # add it, although it could be overriden
- $other->add_override_method_modifier(
- $method_name,
- $self->get_override_method_modifier($method_name),
- $self->name
- );
+ # it if it has one already then ...
+ if ($other->has_method($method_name)) {
+ # if it is being composed into another role
+ # we have a conflict here, because you cannot
+ # combine an overriden method with a locally
+ # defined one
+ if ($other->isa('Moose::Meta::Role')) {
+ confess "Role '" . $self->name . "' has encountered an 'override' method conflict " .
+ "during composition (A local method of the same name as been found). This " .
+ "is fatal error.";
+ }
+ else {
+ # if it is a class, then we
+ # just ignore this here ...
+ next;
+ }
+ }
+ else {
+ # if no local method is found, then we
+ # must check if we are a role or class
+ if ($other->isa('Moose::Meta::Role')) {
+ # if we are a role, we need to make sure
+ # we dont have a conflict with the role
+ # we are composing into
+ if ($other->has_override_method_modifier($method_name)) {
+ confess "Role '" . $self->name . "' has encountered an 'override' method conflict " .
+ "during composition (Two 'override' methods of the same name encountered). " .
+ "This is fatal error.";
+ }
+ else {
+ $other->add_override_method_modifier(
+ $method_name,
+ $self->get_override_method_modifier($method_name),
+ $self->name
+ );
+ }
+ }
+ else {
+ # if it is a class, we just add it
+ $other->add_override_method_modifier(
+ $method_name,
+ $self->get_override_method_modifier($method_name),
+ $self->name
+ );
+ }
+ }
}
foreach my $method_name ($self->get_method_modifier_list('before')) {
$role->apply($combined);
}
- $combined->_clean_up_required_methods;
-
- #warn ">>> req-methods: " . (join ", " => $combined->get_required_method_list) . "\n";
- #warn ">>> methods: " . (join ", " => $combined->get_method_list) . "\n";
- #warn ">>> attrs: " . (join ", " => $combined->get_attribute_list) . "\n";
+ $combined->_clean_up_required_methods;
return $combined;
}
with => sub {
my $meta = _find_meta();
return subname 'Moose::Role::with' => sub {
- my ($role) = @_;
- Moose::_load_all_classes($role);
- $role->meta->apply($meta);
+ my (@roles) = @_;
+ Moose::_load_all_classes(@roles);
+ ($_->can('meta') && $_->meta->isa('Moose::Meta::Role'))
+ || confess "You can only consume roles, $_ is not a Moose role"
+ foreach @roles;
+ if (scalar @roles == 1) {
+ $roles[0]->meta->apply($meta);
+ }
+ else {
+ Moose::Meta::Role->combine(
+ map { $_->meta } @roles
+ )->apply($meta);
+ }
};
},
requires => sub {
use strict;
use warnings;
-use Test::More tests => 16;
+use Test::More tests => 17;
+use Test::Exception;
BEGIN {
use_ok('Moose');
is($foo->foo(), 'Foo::foo', '... got the right value from &foo');
is($foo->bar(), 'Foo::bar', '... got the right value from &bar');
-is($foo->baz(), 'Foo::baz', '... got the right value from &baz');
\ No newline at end of file
+is($foo->baz(), 'Foo::baz', '... got the right value from &baz');
+
+# some error cases
+
+{
+ package Bling;
+ use strict;
+ use warnings;
+ use Moose;
+
+ sub bling { 'Bling::bling' }
+
+ package Bling::Bling;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'Bling';
+
+ sub bling { 'Bling::bling' }
+
+ ::dies_ok {
+ override 'bling' => sub {};
+ } '... cannot override a method which has a local equivalent';
+
+}
+
use strict;
use warnings;
-use Test::More tests => 16;
+use Test::More tests => 17;
+use Test::Exception;
BEGIN {
use_ok('Moose');
is($foo->foo(), 'Foo::foo()', '... got the right value from &foo');
is($foo->bar(), 'Foo::bar()', '... got the right value from &bar');
is($foo->baz(), 'Foo::baz()', '... got the right value from &baz');
+
+# some error cases
+
+{
+ package Bling;
+ use strict;
+ use warnings;
+ use Moose;
+
+ sub bling { 'Bling::bling' }
+
+ package Bling::Bling;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'Bling';
+
+ sub bling { 'Bling::bling' }
+
+ ::dies_ok {
+ augment 'bling' => sub {};
+ } '... cannot augment a method which has a local equivalent';
+
+}
+
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 60;
use Test::Exception;
BEGIN {
ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling::Bling');
+is(Role::Bling::Bling::Bling->meta->get_method('bling')->(),
+ 'Role::Bling::Bling::Bling::bling',
+ '... still got the bling method in Role::Bling::Bling::Bling');
=pod
is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value');
is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value');
+=pod
+
+Role override method conflicts
+
+=cut
+
+{
+ package Role::Spliff;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ override 'twist' => sub {
+ super() . ' -> Role::Spliff::twist';
+ };
+
+ package Role::Blunt;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ override 'twist' => sub {
+ super() . ' -> Role::Blunt::twist';
+ };
+}
+
+{
+ package My::Test::Base;
+ use strict;
+ use warnings;
+ use Moose;
+
+ sub twist { 'My::Test::Base::twist' }
+
+ package My::Test11;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'My::Test::Base';
+
+ ::lives_ok {
+ with 'Role::Blunt';
+ } '... composed the role with override okay';
+
+ package My::Test12;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'My::Test::Base';
+
+ ::lives_ok {
+ with 'Role::Spliff';
+ } '... composed the role with override okay';
+
+ package My::Test13;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::dies_ok {
+ with 'Role::Spliff';
+ } '... cannot compose it because we have no superclass';
+
+ package My::Test14;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'My::Test::Base';
+
+ ::throws_ok {
+ with 'Role::Spliff', 'Role::Blunt';
+ } qr/Two \'override\' methods of the same name encountered/,
+ '... cannot compose it because we have no superclass';
+}
+
+ok(My::Test11->meta->has_method('twist'), '... the twist method has been added');
+ok(My::Test12->meta->has_method('twist'), '... the twist method has been added');
+ok(!My::Test13->meta->has_method('twist'), '... the twist method has not been added');
+ok(!My::Test14->meta->has_method('twist'), '... the twist method has not been added');
+
+is(My::Test11->twist(), 'My::Test::Base::twist -> Role::Blunt::twist', '... got the right method return');
+is(My::Test12->twist(), 'My::Test::Base::twist -> Role::Spliff::twist', '... got the right method return');
+
+
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 2;
-use Test::Exception;
-
-BEGIN {
- use_ok('Moose');
- use_ok('Moose::Role');
-}
\ No newline at end of file
projects / gitmo/Moose.git / commitdiff