[libtype-tiny-perl] 02/04: to_TypeTiny($coderef) wraps calls to the coderef in an eval and another layer of sub; this prevented Type::Tiny from spotting Sub::Quote quoted subs. to_TypeTiny can now handle quoted subs explicitly, inlining the eval.

[Jonas Smedegaard]

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

js pushed a commit to tag 0.043_01
in repository libtype-tiny-perl.

commit 35e7b9b44c83b462a47414fdb3de5dccac70261f
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date:   Sat Apr 5 11:57:36 2014 +0100

    to_TypeTiny($coderef) wraps calls to the coderef in an eval and another layer of sub; this prevented Type::Tiny from spotting Sub::Quote quoted subs. to_TypeTiny can now handle quoted subs explicitly, inlining the eval.
---
 lib/Types/TypeTiny.pm              | 17 +++++++++++++++++
 t/30-integration/Sub-Quote/basic.t | 12 +++++++++++-
 2 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/lib/Types/TypeTiny.pm b/lib/Types/TypeTiny.pm
index bcc4afd..3d5667a 100644
--- a/lib/Types/TypeTiny.pm
+++ b/lib/Types/TypeTiny.pm
@@ -275,6 +275,7 @@ sub _TypeTinyFromGeneric
 	return $new;
 }
 
+my $QFS;
 sub _TypeTinyFromCodeRef
 {
 	my $t = $_[0];
@@ -289,6 +290,22 @@ sub _TypeTinyFromCodeRef
 			return sprintf('%s did not pass type constraint', Type::Tiny::_dd($_));
 		},
 	);
+	
+	if ($QFS ||= "Sub::Quote"->can("quoted_from_sub"))
+	{
+		my (undef, $perlstring, $captures) = @{ $QFS->($t) || [] };
+		$perlstring = "!!eval{ $perlstring }";
+		$opts{inlined} = sub
+		{
+			my $var = $_[1];
+			Sub::Quote::inlinify(
+				$perlstring,
+				$var,
+				$var eq q($_) ? '' : "local \$_ = $var;",
+				1,
+			);
+		} if $perlstring && !$captures;
+	}
 
 	require Type::Tiny;
 	my $new = "Type::Tiny"->new(%opts);
diff --git a/t/30-integration/Sub-Quote/basic.t b/t/30-integration/Sub-Quote/basic.t
index bfb8245..0040d8f 100644
--- a/t/30-integration/Sub-Quote/basic.t
+++ b/t/30-integration/Sub-Quote/basic.t
@@ -33,7 +33,7 @@ use Test::TypeTiny;
 
 use Sub::Quote;
 use Type::Tiny;
-use Types::Standard qw(Int);
+use Types::Standard qw( ArrayRef Int );
 
 my $Type1 = "Type::Tiny"->new(
 	name       => "Type1",
@@ -105,4 +105,14 @@ should_pass(43, $Type6);
 should_fail(44.4, $Type6);
 ok(!$Type6->can_be_inlined, 'constraint built using quote_sub and non-inlinable parent cannot be inlined');
 
+my $Type7 = ArrayRef([Int]) & quote_sub q{ @$_ > 1 and @$_ < 4 };
+
+should_pass([1,2,3], $Type7);
+should_fail([1,2.1,3], $Type7);
+should_fail([1], $Type7);
+should_fail([1,2,3,4], $Type7);
+ok($Type7->can_be_inlined, 'constraint built as an intersection of an inlinable type constraint and a quoted sub can be inlined');
+
+note($Type7->inline_check('$VAR'));
+
 done_testing;

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