From: Matt S Trout Date: Wed, 12 Jan 2011 08:27:41 +0000 (+0000) Subject: Switch package name for class+role composed class to be valid X-Git-Tag: release_0.009006~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoo.git;a=commitdiff_plain;h=c69190f1086805f314dbe3bc2926aa940abd4001 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 --- 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 --- 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 --- 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 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;