From: Matt S Trout Date: Tue, 17 Jul 2012 14:55:30 +0000 (+0000) Subject: add Mouse support for isa/coerce X-Git-Tag: v1.000000~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f96bb37cdf7e575e923baf595d911bc364b3a202;p=gitmo%2FMoo.git add Mouse support for isa/coerce --- diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm index 256b191..fdafb11 100644 --- a/lib/Moo/Role.pm +++ b/lib/Moo/Role.pm @@ -101,13 +101,30 @@ sub _inhale_if_moose { $INFO{$role}{attributes} = [ map +($_ => do { my $spec = { %{$meta->get_attribute($_)} }; + if ($spec->{isa}) { - require Moose::Util::TypeConstraints; - my $tc = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($spec->{isa}); + + my $get_constraint = do { + my $pkg = $meta->isa('Mouse::Meta::Role') + ? 'Mouse::Util::TypeConstraints' + : 'Moose::Util::TypeConstraints'; + _load_module($pkg); + $pkg->can('find_or_create_isa_type_constraint'); + }; + + my $tc = $get_constraint->($spec->{isa}); my $check = $tc->_compiled_type_constraint; - $spec->{isa} = sub { &$check or die "Type constraint failed for $_[0]" }; + + $spec->{isa} = sub { + &$check or die "Type constraint failed for $_[0]" + }; + if ($spec->{coerce}) { - $spec->{coerce} = $tc->coercion->_compiled_type_coercion; + + # Mouse has _compiled_type_coercion straight on the TC object + $spec->{coerce} = $tc->${\( + $tc->can('coercion')||sub { $_[0] } + )}->_compiled_type_coercion; } } $spec; diff --git a/xt/moo-consume-mouse-role-coerce.t b/xt/moo-consume-mouse-role-coerce.t new file mode 100644 index 0000000..4c8281b --- /dev/null +++ b/xt/moo-consume-mouse-role-coerce.t @@ -0,0 +1,33 @@ +use strict; +use warnings; +use Test::More; + +{ + package RoleOne; + use Mouse::Role; + use Mouse::Util::TypeConstraints; + use namespace::autoclean; + + subtype 'Foo', as 'Int'; + coerce 'Foo', from 'Str', via { 3 }; + + has foo => ( + is => 'rw', + isa => 'Foo', + coerce => 1, + clearer => '_clear_foo', + ); +} +{ + package Class; + use Moo; # Works if use Moose.. + use namespace::clean -except => 'meta'; + + with 'RoleOne'; +} + +my $i = Class->new( foo => 'bar' ); +is $i->foo, 3; + +done_testing; +