[libmoox-late-perl] 03/07: get type constraints to inflate properly

[Intrigeri]

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

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

commit e272a904f7483e5b7242f815e2bf42a746758e08
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date:   Sun Dec 2 21:10:25 2012 +0000

    get type constraints to inflate properly
---
 lib/MooX/late.pm | 28 ++++++++++++++++++++++++----
 t/02inflation.t  | 26 ++++++++++++++++++++++++++
 2 files changed, 50 insertions(+), 4 deletions(-)

diff --git a/lib/MooX/late.pm b/lib/MooX/late.pm
index d1b88c2..1085894 100644
--- a/lib/MooX/late.pm
+++ b/lib/MooX/late.pm
@@ -208,7 +208,10 @@ sub _process_lazy_build
 				CodeRef   => sub { ref($_[0]) eq 'CODE' },
 				RegexpRef => sub { ref($_[0]) eq 'Regexp' },
 				GlobRef   => sub { ref($_[0]) eq 'GLOB' },
-				FileHandle=> sub { Scalar::Util::openhandle($_[0]) or blessed($_[0]) && $_[0]->isa('IO::Handle') },
+				FileHandle=> sub {
+					Scalar::Util::openhandle($_[0]) or
+					blessed($_[0]) && $_[0]->isa('IO::Handle');
+				},
 				Object    => sub { blessed($_[0]) },
 				ClassName => sub { is_module_name($_[0]) },
 				RoleName  => sub { is_module_name($_[0]) },
@@ -241,6 +244,13 @@ sub _process_lazy_build
 			{
 				return sub { !defined($_[0]) or $inner->($_[0]) };
 			}
+			if ($outer eq 'ScalarRef')
+			{
+				return sub {
+					return unless ref $_[0] eq 'SCALAR';
+					$inner->(${$_[0]});
+				};
+			}
 			if ($outer eq 'ArrayRef')
 			{
 				return sub {
@@ -261,6 +271,8 @@ sub _process_lazy_build
 					return 1;
 				};
 			}
+			
+			return sub { 1 };
 		}
 		
 		if (is_module_name($tc))
@@ -273,9 +285,17 @@ sub _process_lazy_build
 	
 	sub _fatal_type_constraint
 	{
-		my $tc = _type_constraint(my $tc_name = shift);
-		return sub { 1 } unless $tc;
-		return sub { $tc->($_[0]) or die "value '$_[0]' is not a $tc_name" };
+		my $tc    = _type_constraint(my $tc_name = shift);
+		my $fatal = $tc
+			? sub { $tc->($_[0]) or die "value '$_[0]' is not a $tc_name" }
+			: sub { 1 };
+		
+		# For inflation
+		$Moo::HandleMoose::TYPE_MAP{$fatal} = sub {
+			Moose::Util::TypeConstraints::find_or_parse_type_constraint($tc_name)
+		};
+		
+		return $fatal;
 	}
 }
 
diff --git a/t/02inflation.t b/t/02inflation.t
new file mode 100644
index 0000000..7dcee9e
--- /dev/null
+++ b/t/02inflation.t
@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+	package Local::Class;
+	use Moo;
+	use MooX::late;
+	has foo => (is => 'ro', isa => 'Str', default => 'foo');
+};
+
+ok not eval {
+	my $obj = Local::Class->new(foo => [])
+};
+
+eval {
+	require Moose;
+	
+	my $foo = Local::Class->meta->get_attribute('foo');
+	is(
+		$foo->type_constraint->name,
+		'Str',
+	);
+};
+
+done_testing;

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