The attached patches fix this bug.
From talking on #moose, the coerce attribute had a problem in that its
reader should be "should_coerce" not "rw". It has to be lazy in case
coerce is checked before isa.
Also, most of #moose was disturbed by the MX::ClassAttribute tie in.
From 815f0e375f73fbb484f101dc9f5f9e0650c32de9 Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Sun, 27 Jun 2010 16:50:39 -0700
Subject: [PATCH 2/2] [rt.cpan.org 58885] Only coerce if the accessor's type can coerce.
Otherwise the Moose will get angry.
---
lib/MooseX/AlwaysCoerce.pm | 14 ++++++++++++--
t/01-basic.t | 8 +++++++-
2 files changed, 19 insertions(+), 3 deletions(-)
diff --git a/lib/MooseX/AlwaysCoerce.pm b/lib/MooseX/AlwaysCoerce.pm
index fbb1e1f..d89af63 100644
--- a/lib/MooseX/AlwaysCoerce.pm
+++ b/lib/MooseX/AlwaysCoerce.pm
@@ -54,18 +54,28 @@ Use C<< coerce => 0 >> to disable a coercion explicitly.
use namespace::autoclean;
use Moose::Role;
- has coerce => (is => 'rw', default => 1);
+ has "coerce" => (
+ lazy => 1,
+ reader => "should_coerce",
+ default => sub {
+ return 1 if shift->type_constraint->has_coercion;
+ return 0;
+ }
+ );
+
package MooseX::AlwaysCoerce::Role::Meta::Class;
use namespace::autoclean;
use Moose::Role;
+ use Moose::Util::TypeConstraints;
around add_class_attribute => sub {
my $next = shift;
my $self = shift;
my ($what, %opts) = @_;
- $opts{coerce} = 1 unless exists $opts{coerce};
+ my $type = Moose::Util::TypeConstraints::find_or_parse_type_constraint($opts{isa});
+ $opts{coerce} = 1 if !exists $opts{coerce} and $type->has_coercion;
$self->$next($what, %opts);
};
diff --git a/t/01-basic.t b/t/01-basic.t
index 1f7f3b1..506d08d 100644
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More tests => 6;
{
package MyClass;
@@ -10,9 +10,13 @@ use Test::More tests => 5;
use MooseX::AlwaysCoerce;
use Moose::Util::TypeConstraints;
+ subtype 'NoCoerce', as 'Some::Class';
+
subtype 'MyType', as 'Int';
coerce 'MyType', from 'Str', via { length $_ };
+ has no_coerce => (is => 'rw', isa => 'NoCoerce' );
+
has foo => (is => 'rw', isa => 'MyType');
class_has bar => (is => 'rw', isa => 'MyType');
@@ -37,3 +41,5 @@ undef $@;
eval { $instance->quux('mtfnpy') };
ok( $@, 'attribute coercion did not run with coerce => 0' );
+
+ok eval { $instance->no_coerce( bless {}, "Some::Class" ); } || diag $@;
--
1.7.1
From d2f1a0f6ead86f8d8b6fa1de7c29bd5c7023b5a6 Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Sun, 27 Jun 2010 16:50:16 -0700
Subject: [PATCH 1/2] Better diagnostics when the evals fail.
---
t/01-basic.t | 4 ++--
1 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/t/01-basic.t b/t/01-basic.t
index b3643e5..1f7f3b1 100644
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -25,10 +25,10 @@ use Test::More tests => 5;
ok( (my $instance = MyClass->new), 'instance' );
eval { $instance->foo('bar') };
-ok( (!$@), 'attribute coercion ran' );
+is $@, "", 'attribute coercion ran';
eval { $instance->bar('baz') };
-ok( (!$@), 'class attribute coercion ran' );
+is $@, "", 'class attribute coercion ran';
eval { $instance->baz('quux') };
ok( $@, 'class attribute coercion did not run with coerce => 0' );
--
1.7.1
