roles

diff --git a/TODO b/TODO
index 6393ccb..6652049 100644 (file)
--- a/TODO
+++ b/TODO
@@ -2,10 +2,6 @@
 TODO
 -------------------------------------------------------------------------------
 
-- roles
-
-Need to figure out the details of composite roles
-
 - type unions
 
 Add support for doing it with Classes which do not have 
@@ -94,27 +90,6 @@ and that if this usage style is used nothing is exported to the namespace.
 [23:40]        mst     right
 ...
 [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

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 2690bf1..7804b2a 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -38,8 +38,10 @@ sub does_role {
     my ($self, $role_name) = @_;
     (defined $role_name)
         || confess "You must supply a role name to look for";
-    foreach my $role (@{$self->roles}) {
-        return 1 if $role->does_role($role_name);
+    foreach my $class ($self->class_precedence_list) {
+        foreach my $role (@{$class->meta->roles}) {
+            return 1 if $role->does_role($role_name);
+        }
     }
     return 0;
 }
@@ -48,8 +50,10 @@ sub excludes_role {
     my ($self, $role_name) = @_;
     (defined $role_name)
         || confess "You must supply a role name to look for";
-    foreach my $role (@{$self->roles}) {
-        return 1 if $role->excludes_role($role_name);
+    foreach my $class ($self->class_precedence_list) {        
+        foreach my $role (@{$class->meta->roles}) {
+            return 1 if $role->excludes_role($role_name);
+        }
     }
     return 0;
 }

diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 3eb9ef3..61c8f29 100644 (file)
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -275,7 +275,7 @@ sub apply {
 #    warn "... Checking " . $self->name . " for excluded methods";
     foreach my $excluded_role_name ($self->get_excluded_roles_list) {
 #        warn "... Checking if '$excluded_role_name' is done by " . $other->name . " for " . $self->name;
-        if ($other->does_role($excluded_role_name)) { # || $self->does_role($excluded_role_name) 
+        if ($other->does_role($excluded_role_name)) { 
             confess "The class " . $other->name . " does the excluded role '$excluded_role_name'";
         }
         else {

diff --git a/t/045_role_exclusion.t b/t/045_role_exclusion.t
index ed6a7ac..6aa72bb 100644 (file)
--- a/t/045_role_exclusion.t
+++ b/t/045_role_exclusion.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 15;
+use Test::More tests => 24;
 use Test::Exception;
 
 BEGIN {
@@ -53,6 +53,13 @@ is_deeply(
    [ 'Molecule::Inorganic' ],
    '... Molecule::Organic exludes Molecule::Inorganic');
 
+=pod
+
+Check some basic conflicts when combining  
+the roles into the same class
+
+=cut
+
 {
     package My::Test1;
     use strict;
@@ -89,18 +96,49 @@ is_deeply(
 }
 
 ok(My::Test1->does('Molecule::Organic'), '... My::Test1 does Molecule::Organic');
+ok(My::Test1->does('Molecule'), '... My::Test1 does Molecule');
 ok(My::Test1->meta->excludes_role('Molecule::Inorganic'), '... My::Test1 excludes Molecule::Organic');
+
 ok(!My::Test2->does('Molecule::Organic'), '... ! My::Test2 does Molecule::Organic');
 ok(!My::Test2->does('Molecule::Inorganic'), '... ! My::Test2 does Molecule::Inorganic');
+
 ok(My::Test3->does('Molecule::Organic'), '... My::Test3 does Molecule::Organic');
+ok(My::Test3->does('Molecule'), '... My::Test1 does Molecule');
 ok(My::Test3->meta->excludes_role('Molecule::Inorganic'), '... My::Test3 excludes Molecule::Organic');
 ok(!My::Test3->does('Molecule::Inorganic'), '... ! My::Test3 does Molecule::Inorganic');
 
+=pod
 
+Check some basic conflicts when combining  
+the roles into the a superclass
 
+=cut
 
+{
+    package Methane;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    with 'Molecule::Organic';
+    
+    package My::Test4;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    extends 'Methane';    
+    
+    ::throws_ok {
+        with 'Molecule::Inorganic';    
+    } qr/Conflict detected: My::Test4 excludes role \'Molecule::Inorganic\'/,
+    '... cannot add exculded role into class which extends Methane';
+}
 
-
-
-
+ok(Methane->does('Molecule::Organic'), '... Methane does Molecule::Organic');
+ok(My::Test4->isa('Methane'), '... My::Test4 isa Methane');
+ok(My::Test4->does('Molecule::Organic'), '... My::Test4 does Molecule::Organic');
+ok(My::Test4->meta->does_role('Molecule::Organic'), '... My::Test4 meat does_role Molecule::Organic');
+ok(My::Test4->meta->excludes_role('Molecule::Inorganic'), '... My::Test4 meta excludes Molecule::Organic');
+ok(!My::Test4->does('Molecule::Inorganic'), '... My::Test4 does Molecule::Inorganic');