From: Dave Rolsky Date: Mon, 11 Apr 2011 15:33:15 +0000 (-0500) Subject: Add a thorough test for inlining TCs, especially testing parameterized types and... X-Git-Tag: 2.0100~73 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5c40cf37e51a22804246f18753545f8403b817e3;p=gitmo%2FMoose.git Add a thorough test for inlining TCs, especially testing parameterized types and unions --- diff --git a/t/type_constraints/inlining.t b/t/type_constraints/inlining.t new file mode 100644 index 0000000..1523366 --- /dev/null +++ b/t/type_constraints/inlining.t @@ -0,0 +1,189 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::Fatal; +use Test::More; + +use Moose::Util::TypeConstraints; + +#<<< +subtype 'Inlinable', + as 'Str', + where { $_ !~ /Q/ }, + inline_as { "defined $_[1] && ! ref $_[1] && $_[1] !~ /Q/" }; + +subtype 'NotInlinable', + as 'Str', + where { $_ !~ /Q/ }; +#>>> + +my $inlinable = find_type_constraint('Inlinable'); +my $not_inlinable = find_type_constraint('NotInlinable'); + +{ + ok( + $inlinable->has_inlined_type_constraint, + 'Inlinable returns true for has_inlined_type_constraint' + ); + + is( + $inlinable->_inline_check('$foo'), + 'defined $foo && ! ref $foo && $foo !~ /Q/', + 'got expected inline code for Inlinable constraint' + ); + + ok( + !$not_inlinable->has_inlined_type_constraint, + 'NotInlinable returns false for has_inlined_type_constraint' + ); + + like( + exception { $not_inlinable->_inline_check('$foo') }, + qr/Cannot inline a type constraint check for NotInlinable/, + 'threw an exception when asking for inlinable code from type which cannot be inlined' + ); +} + +{ + my $aofi = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'ArrayRef[Inlinable]'); + + ok( + $aofi->has_inlined_type_constraint, + 'ArrayRef[Inlinable] returns true for has_inlined_type_constraint' + ); + + is( + $aofi->_inline_check('$foo'), + '&List::MoreUtils::all( sub { defined $_ && ! ref $_ && $_ !~ /Q/ }, @{$foo} )', + 'got expected inline code for ArrayRef[Inlinable] constraint' + ); + + my $aofni = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'ArrayRef[NotInlinable]'); + + ok( + !$aofni->has_inlined_type_constraint, + 'ArrayRef[NotInlinable] returns false for has_inlined_type_constraint' + ); +} + +subtype 'ArrayOfInlinable', + as 'ArrayRef[Inlinable]'; + +subtype 'ArrayOfNotInlinable', + as 'ArrayRef[NotInlinable]'; + +{ + local $TODO = 'A subtype of a Parameterized type should not be a Parameterizable type'; + + my $aofi = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'ArrayRef[Inlinable]'); + + ok( + $aofi->has_inlined_type_constraint, + 'ArrayOfInlinable returns true for has_inlined_type_constraint' + ); +} + +{ + my $hoaofi = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'HashRef[ArrayRef[Inlinable]]'); + + ok( + $hoaofi->has_inlined_type_constraint, + 'HashRef[ArrayRef[Inlinable]] returns true for has_inlined_type_constraint' + ); + + is( + $hoaofi->_inline_check('$foo'), + '&List::MoreUtils::all( sub { &List::MoreUtils::all( sub { defined $_ && ! ref $_ && $_ !~ /Q/ }, @{$_} ) }, values %{$foo} )', + 'got expected inline code for HashRef[ArrayRef[Inlinable]] constraint' + ); + + my $hoaofni = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'HashRef[ArrayRef[NotInlinable]]'); + + ok( + !$hoaofni->has_inlined_type_constraint, + 'HashRef[ArrayRef[NotInlinable]] returns false for has_inlined_type_constraint' + ); +} + +{ + my $iunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'Inlinable | Object'); + + ok( + $iunion->has_inlined_type_constraint, + 'Inlinable | Object returns true for has_inlined_type_constraint' + ); + + is( + $iunion->_inline_check('$foo'), + '(defined $foo && ! ref $foo && $foo !~ /Q/) || (Scalar::Util::blessed( $foo ))', + 'got expected inline code for Inlinable | Object constraint' + ); + + my $niunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'NotInlinable | Object'); + + ok( + !$niunion->has_inlined_type_constraint, + 'NotInlinable | Object returns false for has_inlined_type_constraint' + ); +} + +{ + my $iunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'Object | Inlinable'); + + ok( + $iunion->has_inlined_type_constraint, + 'Object | Inlinable returns true for has_inlined_type_constraint' + ); + + is( + $iunion->_inline_check('$foo'), + '(Scalar::Util::blessed( $foo )) || (defined $foo && ! ref $foo && $foo !~ /Q/)', + 'got expected inline code for Object | Inlinable constraint' + ); + + my $niunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'Object | NotInlinable'); + + ok( + !$niunion->has_inlined_type_constraint, + 'Object | NotInlinable returns false for has_inlined_type_constraint' + ); +} + +{ + my $iunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'Object | Inlinable | CodeRef'); + + ok( + $iunion->has_inlined_type_constraint, + 'Object | Inlinable | CodeRef returns true for has_inlined_type_constraint' + ); + + is( + $iunion->_inline_check('$foo'), + q{(Scalar::Util::blessed( $foo )) || (defined $foo && ! ref $foo && $foo !~ /Q/) || (ref $foo eq 'CODE')}, + 'got expected inline code for Object | Inlinable | CodeRef constraint' + ); + + my $niunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( + 'Object | NotInlinable | CodeRef'); + + ok( + !$niunion->has_inlined_type_constraint, + 'Object | NotInlinable | CodeRef returns false for has_inlined_type_constraint' + ); +} + + + +done_testing;