From a193e05da9516baf524330e059841ba63a6a997c Mon Sep 17 00:00:00 2001 From: Karen Etheridge Date: Thu, 29 Jul 2010 15:18:15 -0700 Subject: potential fixes for role problems.. doesnt solve everything though; will have to see if MX::ClassAttribute is partially to blame here (See https://rt.cpan.org/Public/Bug/Display.html?id=59844) --- lib/MooseX/AlwaysCoerce.pm | 12 +++++++- t/04-parameterized-roles.t | 71 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+), 1 deletion(-) create mode 100644 t/04-parameterized-roles.t diff --git a/lib/MooseX/AlwaysCoerce.pm b/lib/MooseX/AlwaysCoerce.pm index 0f2c398..96b6213 100644 --- a/lib/MooseX/AlwaysCoerce.pm +++ b/lib/MooseX/AlwaysCoerce.pm @@ -68,6 +68,7 @@ Use C<< coerce => 0 >> to disable a coercion explicitly. use namespace::autoclean; use Moose::Role; use Moose::Util::TypeConstraints; + use MooseX::ClassAttribute; around add_class_attribute => sub { my $next = shift; @@ -82,18 +83,27 @@ Use C<< coerce => 0 >> to disable a coercion explicitly. } my (undef, undef, $init_meta) = Moose::Exporter->build_import_methods( + install => [ qw(import unimport) ], + class_metaroles => { attribute => ['MooseX::AlwaysCoerce::Role::Meta::Attribute'], class => ['MooseX::AlwaysCoerce::Role::Meta::Class'], }, + + also => ['MooseX::ClassAttribute'], ); sub init_meta { my ($class, %options) = @_; my $for_class = $options{for_class}; - MooseX::ClassAttribute->import({ into => $for_class }); + # Bring this in only if we are being applied to a + # metaclass, but not a metarole. + if (Class::MOP::class_of($for_class)->isa('Class::MOP::Class')) + { + MooseX::ClassAttribute->import({ into => $for_class }); + } # call generated method to do the rest of the work. goto $init_meta; diff --git a/t/04-parameterized-roles.t b/t/04-parameterized-roles.t new file mode 100644 index 0000000..1a296d6 --- /dev/null +++ b/t/04-parameterized-roles.t @@ -0,0 +1,71 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use Test::More; + +BEGIN { + if (eval { require MooseX::Role::Parameterized }) { + plan tests => 8; + } else { + plan skip_all => 'This test needs MooseX::Role::Parameterized'; + } +} + +{ + package Role; + use MooseX::Role::Parameterized; + use MooseX::AlwaysCoerce; + use Moose::Util::TypeConstraints; + + # I do nothing! + role {}; + use Moose::Util::TypeConstraints; + + subtype 'MyType', as 'Int'; + coerce 'MyType', from 'Str', via { length $_ }; + + subtype 'Uncoerced', as 'Int'; + + has foo => (is => 'rw', isa => 'MyType'); + + class_has bar => (is => 'rw', isa => 'MyType'); + + class_has baz => (is => 'rw', isa => 'MyType', coerce => 0); + + has quux => (is => 'rw', isa => 'MyType', coerce => 0); + + has uncoerced_attr => (is => 'rw', isa => 'Uncoerced'); + + class_has uncoerced_class_attr => (is => 'rw', isa => 'Uncoerced'); +} + +{ + package Foo; + use Moose; + with 'Role'; +} + +package main; +use Test::Exception; +use Test::NoWarnings; + +ok( (my $instance = MyClass->new), 'instance' ); + +lives_ok { $instance->foo('bar') } 'attribute coercion ran'; + +lives_ok { $instance->bar('baz') } 'class attribute coercion ran'; + +dies_ok { $instance->baz('quux') } + 'class attribute coercion did not run with coerce => 0'; + +dies_ok { $instance->quux('mtfnpy') } + 'attribute coercion did not run with coerce => 0'; + +lives_ok { $instance->uncoerced_attr(10) } + 'set attribute having type with no coercion and no coerce=0'; + +lives_ok { $instance->uncoerced_class_attr(10) } + 'set class attribute having type with no coercion and no coerce=0'; + + -- cgit v1.2.3