Switch package name for class+role composed class to be valid

We used to join together the components with + so you got -

  Class+Role1+Role2+Role3

however this then screws with Sub::Quote's ability to generate a constructor
into the final class since

  sub Class+Role1+Role2+Role3::new {

isn't valid perl. Therefore, I've switched the code to generate

  Class__WITH__Role1__AND__Role3__AND__Role3

which is substantially uglier but works. Thanks to DGL for the test

diff --git a/Changes b/Changes
index bf9b6f4..627b689 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+  - Switch composed role names to be a valid package name
+
 0.9.5 Tue Jan 11 2011
   - Fix clobberage of runtime-installed wrappers by Sub::Defer
   - Fix nonMoo constructor firing through multiple layers of Moo

diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm
index a8c2083..4055fbc 100644 (file)
--- a/lib/Moo/Role.pm
+++ b/lib/Moo/Role.pm
@@ -34,7 +34,10 @@ sub apply_role_to_package {
 sub create_class_with_roles {
   my ($me, $superclass, @roles) = @_;
 
-  my $new_name = join('+', $superclass, my $compose_name = join '+', @roles);
+  my $new_name = join(
+    '__WITH__', $superclass, my $compose_name = join '__AND__', @roles
+  );
+
   return $new_name if $Role::Tiny::COMPOSED{class}{$new_name};
 
   require Sub::Quote;
@@ -45,6 +48,8 @@ sub create_class_with_roles {
     die "${role} is not a Role::Tiny" unless my $info = $INFO{$role};
   }
 
+  $Moo::MAKERS{$new_name} = {};
+
   $me->_handle_constructor(
     $new_name, { map %{$INFO{$_}{attributes}||{}}, @roles }, $superclass
   );

diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm
index 1c7b051..7d185ae 100644 (file)
--- a/lib/Role/Tiny.pm
+++ b/lib/Role/Tiny.pm
@@ -84,7 +84,10 @@ sub create_class_with_roles {
 
   die "No roles supplied!" unless @roles;
 
-  my $new_name = join('+', $superclass, my $compose_name = join '+', @roles);
+  my $new_name = join(
+    '__WITH__', $superclass, my $compose_name = join '__AND__', @roles
+  );
+
   return $new_name if $COMPOSED{class}{$new_name};
 
   foreach my $role (@roles) {

diff --git a/t/accessor-roles.t b/t/accessor-roles.t
new file mode 100644 (file)
index 0000000..eb8b8b6
--- /dev/null
+++ b/t/accessor-roles.t
@@ -0,0 +1,25 @@
+use strictures 1;
+use Test::More;
+use Sub::Quote;
+
+{
+  package One; use Moo;
+  has one => (is => 'ro', default => sub { 'one' });
+
+  package One::P1; use Moo::Role;
+  has two => (is => 'ro', default => sub { 'two' });
+
+  package One::P2; use Moo::Role;
+  has three => (is => 'ro', default => sub { 'three' });
+}
+
+my $combined = Moo::Role->create_class_with_roles('One', qw(One::P1 One::P2));
+isa_ok $combined, "One";
+ok $combined->does($_), "Does $_" for qw(One::P1 One::P2);
+
+my $c = $combined->new;
+is $c->one, "one",     "attr default set from class";
+is $c->two, "two",     "attr default set from role";
+is $c->three, "three", "attr default set from role";
+
+done_testing;