[libmoox-late-perl] 02/05: support coerce => 1

[Intrigeri]

This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to tag 0.014
in repository libmoox-late-perl.

commit ab489343ddd21ede168d7183887ea85cca66076b
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date:   Tue Jul 16 21:39:12 2013 +0100

    support coerce => 1
---
 lib/MooX/late.pm   | 38 +++++++++++++++++++++++++++++++++-----
 meta/makefile.pret |  1 +
 t/07coerce1.t      | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 81 insertions(+), 5 deletions(-)

diff --git a/lib/MooX/late.pm b/lib/MooX/late.pm
index 4e9cf1b..94f08bd 100644
--- a/lib/MooX/late.pm
+++ b/lib/MooX/late.pm
@@ -61,7 +61,7 @@ BEGIN {
 # 
 sub _handlers
 {
-	qw( isa lazy_build traits );
+	qw( isa coerce lazy_build traits );
 }
 
 # SUBCLASSING
@@ -170,6 +170,29 @@ sub _handle_isa
 	return;
 }
 
+sub _handle_coerce
+{
+	my $me = shift;
+	my ($name, $spec, $context, $class) = @_;
+	
+	my $c = $spec->{coerce};
+	my $i = $spec->{isa};
+	
+	if (defined($c) and !ref($c) and $c == 1)
+	{
+		if (blessed($i) and $i->isa('Type::Tiny') and $i->has_coercion)
+		{
+			$spec->{coerce} = $i->coercion;
+		}
+		elsif (blessed($i) and $i->can('has_coercion') and $i->has_coercion and $i->can('coerce'))
+		{
+			$spec->{coerce} = sub { $i->coerce(@_) };
+		}
+	}
+	
+	return;
+}
+
 sub _handle_lazy_build
 {
 	my $me = shift;
@@ -353,11 +376,16 @@ supported because of internal implementation details of Moo. If you need
 another attribute trait to be supported, let me know and I will consider
 it.
 
+=item 6.
+
+Supports C<< coerce => 1 >> if the type constraint is a blessed object
+implementing L<Type::API::Constraint::Coercible>.
+
 =back
 
-Four features. It is not the aim of C<MooX::late> to make every aspect of
+Five features. It is not the aim of C<MooX::late> to make every aspect of
 Moo behave exactly identically to Moose. It's just going after the low-hanging
-fruit. So it does four things right now, and I promise that future versions
+fruit. So it does five things right now, and I promise that future versions
 will never do more than seven.
 
 =head2 Use in Moo::Roles
@@ -373,8 +401,8 @@ parameterized roles. MooX::late should work in roles built with
 Package::Variant.
 
    use Package::Variant
-      importing => ['MooX::Role' => ['late']],
-      subs      => [ qw(has with) ];
+      importing => [ qw( Moo::Role MooX::late ) ],
+      subs      => [ qw( has with ) ];
 
 =head2 Type constraints
 
diff --git a/meta/makefile.pret b/meta/makefile.pret
index 5321c4a..601a6b5 100644
--- a/meta/makefile.pret
+++ b/meta/makefile.pret
@@ -6,6 +6,7 @@
 	readme_from       m`MooX::late`;
 	test_requires     p`Test::More 0.96`;
 	test_requires     p`Test::Requires 0.06`;
+	test_requires     p`Test::Fatal 0.010`;
 	requires          p`Moo 1.003000`;
 	requires          p`Type::Utils 0.016`;
 	recommends        p`MooX`;
diff --git a/t/07coerce1.t b/t/07coerce1.t
new file mode 100644
index 0000000..e8dad36
--- /dev/null
+++ b/t/07coerce1.t
@@ -0,0 +1,47 @@
+=head1 PURPOSE
+
+See if C<< coerce => 1 >> works.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink at cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+
+use Types::Standard qw( Int Num );
+
+my $Int = Int->plus_coercions( Num, q{int($_)} );
+
+{
+	package Foo;
+	use Moo; use MooX::late;
+	has attr => (is => 'ro', isa => $Int, coerce => 1);
+}
+
+is(
+	Foo->new(attr => 3.14159)->attr,
+	3,
+);
+
+like(
+	exception {
+		package Bar;
+		use Moo; use MooX::late;
+		has attr => (is => 'ro', isa => $Int->no_coercions, coerce => 1);
+	},
+	qr{^Invalid coerce '1'},
+);
+
+done_testing;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmoox-late-perl.git