@@ -1,5 +1,13 @@
Revision history for Moo
+1.006000 - 2014-08-16
+ - support coerce => 1 in attributes, taking the coercion from the isa option
+ if it is an object that supports the coerce or coercion method.
+ - add attribute information to type check errors by trapping with an eval
+ rather than overriding the global __DIE__ handler
+ - bump Module::Runtime prerequisite to fix error messages when there is a
+ missing module used by a role loaded using 'with' or similar (rt#97669)
+
1.005000 - 2014-06-10
- add qsub to Sub::Quote as a prototyped alternative to quote_sub, accepting
only the sub body
@@ -38,6 +38,7 @@ t/buildall-subconstructor.t
t/buildall.t
t/buildargs-error.t
t/buildargs.t
+t/coerce-1.t
t/compose-non-role.t
t/compose-roles.t
t/demolish-basics.t
@@ -133,6 +134,7 @@ xt/type-inflate-coercion.t
xt/type-inflate-threads.t
xt/type-inflate-type-tiny.t
xt/type-inflate.t
+xt/type-tiny-coerce.t
xt/withautoclean.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
@@ -50,9 +50,10 @@
"Class::Method::Modifiers" : "1.1",
"Devel::GlobalDestruction" : "0.11",
"Import::Into" : "1.002",
- "Module::Runtime" : "0.012",
+ "Module::Runtime" : "0.014",
"Role::Tiny" : "1.003003",
"Scalar::Util" : "0",
+ "perl" : "5.006",
"strictures" : "1.004003"
}
},
@@ -82,7 +83,7 @@
},
"x_IRC" : "irc://irc.perl.org/#moose"
},
- "version" : "1.005000",
+ "version" : "1.006000",
"x_authority" : "cpan:MSTROUT",
"x_breaks" : {
"HTML::Restrict" : "== 2.1.5"
@@ -25,16 +25,17 @@ requires:
Class::Method::Modifiers: '1.1'
Devel::GlobalDestruction: '0.11'
Import::Into: '1.002'
- Module::Runtime: '0.012'
+ Module::Runtime: '0.014'
Role::Tiny: '1.003003'
Scalar::Util: '0'
+ perl: '5.006'
strictures: '1.004003'
resources:
IRC: irc://irc.perl.org/#moose
bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Moo
license: http://dev.perl.org/licenses/
repository: https://github.com/moose/Moo.git
-version: '1.005000'
+version: '1.006000'
x_authority: cpan:MSTROUT
x_breaks:
HTML::Restrict: '== 2.1.5'
@@ -24,11 +24,12 @@ my %META = (
requires => {
'Class::Method::Modifiers' => 1.10, # for RT#80194
'strictures' => 1.004003,
- 'Module::Runtime' => 0.012, # for RT#74789
+ 'Module::Runtime' => 0.014, # for RT#86394
'Role::Tiny' => 1.003003,
'Devel::GlobalDestruction' => 0.11, # for RT#78617
'Import::Into' => 1.002,
'Scalar::Util' => 0,
+ 'perl' => 5.006,
},
recommends => {
'Class::XSAccessor' => 1.18,
@@ -95,7 +96,7 @@ $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META }
for (qw(configure build test runtime)) {
my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES';
my $r = $MM_ARGS{$key} = {
- %{$META{prereqs}{$_}{requires}},
+ %{$META{prereqs}{$_}{requires} || {}},
%{delete $MM_ARGS{$key} || {}},
};
defined $r->{$_} or delete $r->{$_} for keys %$r;
@@ -89,9 +89,9 @@ MOO AND MOOSE
to use them in Moose code without anybody ever noticing you aren't using
Moose everywhere.
- Moo will also create Moose type constraints for classes and roles, so
- that "isa => 'MyClass'" and "isa => 'MyRole'" work the same as for Moose
- classes and roles.
+ Moo will also create Moose type constraints for Moo classes and roles,
+ so that in Moose classes "isa => 'MyMooClass'" and "isa => 'MyMooRole'"
+ work the same as for Moose classes and roles.
Extending a Moose class or consuming a Moose::Role will also work.
@@ -251,7 +251,7 @@ IMPORTED SUBROUTINES
The options for "has" are as follows:
- * is
+ * "is"
required, may be "ro", "lazy", "rwp" or "rw".
@@ -276,7 +276,7 @@ IMPORTED SUBROUTINES
"rw" generates a normal getter/setter by defaulting "accessor" to the
name of the attribute.
- * isa
+ * "isa"
Takes a coderef which is meant to validate the attribute. Unlike
Moose, Moo does not include a basic type system, so instead of doing
@@ -313,7 +313,7 @@ IMPORTED SUBROUTINES
Moose::Meta::TypeConstraint object or something similar enough to it
to make Moose happy is fine.
- * coerce
+ * "coerce"
Takes a coderef which is meant to coerce the attribute. The basic idea
is to do something like the following:
@@ -330,7 +330,10 @@ IMPORTED SUBROUTINES
Sub::Quote aware
- * handles
+ If the "isa" option is a blessed object providing a "coerce" or
+ "coercion" method, then the "coerce" option may be set to just 1.
+
+ * "handles"
Takes a string
@@ -23,19 +23,6 @@ BEGIN {
my $module_name_only = qr/\A$Module::Runtime::module_name_rx\z/;
-sub _SIGDIE
-{
- our ($CurrentAttribute, $OrigSigDie);
- my $sigdie = $OrigSigDie && $OrigSigDie != \&_SIGDIE
- ? $OrigSigDie
- : sub { die $_[0] };
-
- return $sigdie->(@_) if ref($_[0]);
-
- my $attr_desc = _attr_desc(@$CurrentAttribute{qw(name init_arg)});
- $sigdie->("$CurrentAttribute->{step} for $attr_desc failed: $_[0]");
-}
-
sub _die_overwrite
{
my ($pkg, $method, $type) = @_;
@@ -82,6 +69,16 @@ sub generate_method {
if (($spec->{trigger}||0) eq 1) {
$spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)');
}
+ if (($spec->{coerce}||0) eq 1) {
+ my $isa = $spec->{isa};
+ if (blessed $isa and $isa->can('coercion')) {
+ $spec->{coerce} = $isa->coercion;
+ } elsif (blessed $isa and $isa->can('coerce')) {
+ $spec->{coerce} = sub { $isa->coerce(@_) };
+ } else {
+ die "Invalid coercion for $into->$name - no appropriate type constraint";
+ }
+ }
for my $setting (qw( isa coerce )) {
next if !exists $spec->{$setting};
@@ -387,11 +384,12 @@ sub _attr_desc {
sub _generate_coerce {
my ($self, $name, $value, $coerce, $init_arg) = @_;
- $self->_generate_die_prefix(
+ $self->_wrap_attr_exception(
$name,
"coercion",
$init_arg,
- $self->_generate_call_code($name, 'coerce', "${value}", $coerce)
+ $self->_generate_call_code($name, 'coerce', "${value}", $coerce),
+ 1,
);
}
@@ -414,23 +412,40 @@ sub generate_isa_check {
($code, delete $self->{captures});
}
-sub _generate_die_prefix {
- my ($self, $name, $prefix, $arg, $inside) = @_;
+sub _wrap_attr_exception {
+ my ($self, $name, $step, $arg, $code, $want_return) = @_;
+ my $prefix = quotify("${step} for "._attr_desc($name, $arg).' failed: ');
"do {\n"
- .' local $Method::Generate::Accessor::CurrentAttribute = {'
- .' init_arg => '.(defined $arg ? quotify($arg) : 'undef') . ",\n"
+ .' local $Method::Generate::Accessor::CurrentAttribute = {'."\n"
+ .' init_arg => '.quotify($arg).",\n"
.' name => '.quotify($name).",\n"
- .' step => '.quotify($prefix).",\n"
+ .' step => '.quotify($step).",\n"
." };\n"
- .' local $Method::Generate::Accessor::OrigSigDie = $SIG{__DIE__};'."\n"
- .' local $SIG{__DIE__} = \&Method::Generate::Accessor::_SIGDIE;'."\n"
- .$inside
+ .($want_return ? ' my $_return;'."\n" : '')
+ .' my $_error;'."\n"
+ ." {\n"
+ .' my $_old_error = $@;'."\n"
+ ." if (!eval {\n"
+ .' $@ = $_old_error;'."\n"
+ .($want_return ? ' $_return ='."\n" : '')
+ .' '.$code.";\n"
+ ." 1;\n"
+ ." }) {\n"
+ .' $_error = $@;'."\n"
+ .' if (!ref $_error) {'."\n"
+ .' $_error = '.$prefix.'.$_error;'."\n"
+ ." }\n"
+ ." }\n"
+ .' $@ = $_old_error;'."\n"
+ ." }\n"
+ .' die $_error if $_error;'."\n"
+ .($want_return ? ' $_return;'."\n" : '')
."}\n"
}
sub _generate_isa_check {
my ($self, $name, $value, $check, $init_arg) = @_;
- $self->_generate_die_prefix(
+ $self->_wrap_attr_exception(
$name,
"isa check",
$init_arg,
@@ -6,7 +6,7 @@ use Role::Tiny ();
use base qw(Role::Tiny);
use Import::Into;
-our $VERSION = '1.005000';
+our $VERSION = '1.006000';
$VERSION = eval $VERSION;
require Moo::sification;
@@ -4,7 +4,7 @@ use strictures 1;
use Moo::_Utils;
use Import::Into;
-our $VERSION = '1.005000';
+our $VERSION = '1.006000';
$VERSION = eval $VERSION;
require Moo::sification;
@@ -320,8 +320,8 @@ to use them in L<Moose> code without anybody ever noticing you aren't using
L<Moose> everywhere.
L<Moo> will also create L<Moose type constraints|Moose::Manual::Types> for
-classes and roles, so that C<< isa => 'MyClass' >> and C<< isa => 'MyRole' >>
-work the same as for L<Moose> classes and roles.
+L<Moo> classes and roles, so that in Moose classes C<< isa => 'MyMooClass' >>
+and C<< isa => 'MyMooRole' >> work the same as for L<Moose> classes and roles.
Extending a L<Moose> class or consuming a L<Moose::Role> will also work.
@@ -495,7 +495,7 @@ The options for C<has> are as follows:
=over 2
-=item * is
+=item * C<is>
B<required>, may be C<ro>, C<lazy>, C<rwp> or C<rw>.
@@ -518,7 +518,7 @@ This feature comes from L<MooseX::AttributeShortcuts>.
C<rw> generates a normal getter/setter by defaulting C<accessor> to the
name of the attribute.
-=item * isa
+=item * C<isa>
Takes a coderef which is meant to validate the attribute. Unlike L<Moose>, Moo
does not include a basic type system, so instead of doing C<< isa => 'Num' >>,
@@ -555,7 +555,7 @@ Note that this example is purely illustrative; anything that returns a
L<Moose::Meta::TypeConstraint> object or something similar enough to it to
make L<Moose> happy is fine.
-=item * coerce
+=item * C<coerce>
Takes a coderef which is meant to coerce the attribute. The basic idea is to
do something like the following:
@@ -571,7 +571,10 @@ check after the coercion has run to ensure that it returned a valid value.
L<Sub::Quote aware|/SUB QUOTE AWARE>
-=item * handles
+If the C<isa> option is a blessed object providing a C<coerce> or
+C<coercion> method, then the C<coerce> option may be set to just C<1>.
+
+=item * C<handles>
Takes a string
@@ -5,7 +5,7 @@ use base qw(Exporter);
use Moo::_Utils;
use Scalar::Util qw(weaken);
-our $VERSION = '1.005000';
+our $VERSION = '1.006000';
$VERSION = eval $VERSION;
our @EXPORT = qw(defer_sub undefer_sub undefer_all);
@@ -12,7 +12,7 @@ BEGIN {
*_HAVE_PERLSTRING = defined &B::perlstring ? sub(){1} : sub(){0};
}
-our $VERSION = '1.005000';
+our $VERSION = '1.006000';
$VERSION = eval $VERSION;
our @EXPORT = qw(quote_sub unquote_sub quoted_from_sub qsub);
@@ -29,6 +29,18 @@ my $c_ran;
has fourteen => (is => 'ro', required => 1, builder => '_build_fourteen');
sub _build_fourteen { {} }
has fifteen => (is => 'lazy', default => undef);
+
+ # DIE handler was leaking into defaults when coercion is on.
+ has default_with_coerce => (
+ is => 'rw',
+ coerce => sub { return $_[0] },
+ default => sub { eval { die "blah\n" }; return $@; }
+ );
+
+ has default_no_coerce => (
+ is => 'rw',
+ default => sub { eval { die "blah\n" }; return $@; }
+ );
}
sub check {
@@ -71,4 +83,7 @@ my $foo = Foo->new;
is($foo->fifteen, undef, 'undef default');
ok(exists $foo->{fifteen}, 'undef default is stored');
+is( Foo->new->default_with_coerce, "blah\n" );
+is( Foo->new->default_no_coerce, "blah\n" );
+
done_testing;
@@ -154,7 +154,7 @@ is($e->[2], 'isa check', 'step available in isa check');
my $called;
local $SIG{__DIE__} = sub { $called++; die $_[0] };
my $e = exception { Fizz->new(attr_1 => 5) };
- is($called, 1, '__DIE__ handler called if set')
+ ok($called, '__DIE__ handler called if set')
}
{
@@ -173,4 +173,42 @@ like exception { ClassUsingDeadlyIsa->new(bar => 1) },
ComplexWriter->test_with("isa");
+{
+ package ClassWithEvilDestroy;
+ sub new { bless {}, $_[0] }
+ sub DESTROY {
+ eval {
+ # nop
+ };
+ }
+
+ package ClassWithEvilException;
+ use Moo;
+ has foo => (is => 'rw', isa => sub {
+ local $@;
+ die "welp";
+ });
+ has bar => (is => 'rw', isa => sub {
+ my $o = ClassWithEvilDestroy->new;
+ die "welp";
+ });
+ my $error;
+ has baz => (is => 'rw', isa => sub {
+ ::is $@, $error, '$@ unchanged inside isa';
+ 1;
+ });
+
+ my $o = ClassWithEvilException->new;
+
+ ::like ::exception { $o->foo(1) }, qr/isa check for "foo" failed:/,
+ 'got proper exception with localized $@';
+ ::like ::exception { $o->bar(1) }, qr/isa check for "bar" failed:/,
+ 'got proper exception with eval in DESTROY';
+
+ eval { die "blah\n" };
+ $error = $@;
+ $o->baz(1);
+ ::is $@, $error, '$@ unchanged after successful isa';
+}
+
done_testing;
@@ -0,0 +1,92 @@
+use strictures 1;
+use Test::More;
+use Test::Fatal;
+
+{
+ package IntConstraint;
+ use Moo;
+ use overload '&{}' => sub { shift->constraint }, fallback => 1;
+ has constraint => (
+ is => 'ro',
+ default => sub {
+ sub { $_[0] eq int $_[0] or die }
+ },
+ );
+ sub check {
+ my $self = shift;
+ !!eval { $self->constraint->(@_); 1 }
+ }
+}
+
+# First supported interface for coerce=>1.
+# The type constraint provides an $isa->coerce($value) method.
+{
+ package IntConstraint::WithCoerceMethod;
+ use Moo;
+ extends qw(IntConstraint);
+ sub coerce {
+ my $self = shift;
+ int($_[0]);
+ }
+}
+
+# First supported interface for coerce=>1.
+# The type constraint provides an $isa->coercion method
+# providing a coderef such that $coderef->($value) coerces.
+{
+ package IntConstraint::WithCoercionMethod;
+ use Moo;
+ extends qw(IntConstraint);
+ has coercion => (
+ is => 'ro',
+ default => sub {
+ sub { int($_[0]) }
+ },
+ );
+}
+
+{
+ package Goo;
+ use Moo;
+
+ ::like(::exception {
+ has foo => (
+ is => 'ro',
+ isa => sub { $_[0] eq int $_[0] },
+ coerce => 1,
+ );
+ }, qr/Invalid coercion/,
+ 'coerce => 1 not allowed when isa has no coercion');
+
+ ::like(::exception {
+ has foo => (
+ is => 'ro',
+ isa => IntConstraint->new,
+ coerce => 1,
+ );
+ }, qr/Invalid coercion/,
+ 'coerce => 1 not allowed when isa has no coercion');
+
+ has bar => (
+ is => 'ro',
+ isa => IntConstraint::WithCoercionMethod->new,
+ coerce => 1,
+ );
+
+ has baz => (
+ is => 'ro',
+ isa => IntConstraint::WithCoerceMethod->new,
+ coerce => 1,
+ );
+
+}
+
+my $obj = Goo->new(
+ bar => 3.14159,
+ baz => 3.14159,
+);
+
+is($obj->bar, '3', '$isa->coercion');
+is($obj->baz, '3', '$isa->coerce');
+
+done_testing;
@@ -0,0 +1,22 @@
+use strictures 1;
+use Test::More;
+
+{
+ package Goo;
+ use Moo;
+ use Types::Standard qw(Int Num);
+
+ has foo => (
+ is => 'ro',
+ isa => Int->plus_coercions(Num, q{ int($_) }),
+ coerce => 1,
+ );
+}
+
+my $obj = Goo->new(
+ foo => 3.14159,
+);
+
+is($obj->foo, '3', 'Type::Tiny coercion applied with coerce => 1');
+
+done_testing;