diff --git a/Changes b/Changes index e901190..c672347 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,9 @@ Revision history for MooseX-Types {{$NEXT}} + - re-added the is_Foo and to_Food refactoring after resolving + RT #119534 + 0.50 2017-02-07 18:59:30Z - reverted the is_Foo and to_Foo refactoring again temporarily to resolve issues with Sub::Defer @@ -9,7 +12,7 @@ Revision history for MooseX-Types 0.49 2016-12-23 00:12:12Z - made the exported is_Foo and to_Foo subs much faster, especially for type constraints which can be inlined. (Dave Rolsky) [reverted in - 0.50) + 0.50] 0.48 2016-12-07 01:15:14Z - reverted is_Foo and to_Foo refactoring [from 0.47] for now, so they diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm index 0988f43..bdd2c36 100644 --- a/lib/MooseX/Types.pm +++ b/lib/MooseX/Types.pm @@ -12,6 +12,7 @@ use MooseX::Types::Util qw( filter_tags ); use MooseX::Types::UndefinedType; use MooseX::Types::CheckedUtilExports (); use Carp::Clan qw( ^MooseX::Types ); +use Sub::Defer qw( defer_sub ); use Sub::Name; use Scalar::Util qw( reftype ); use Sub::Exporter::ForMethods 0.100052 'method_installer'; # for 'rebless' @@ -486,17 +487,22 @@ This generates a coercion handler function, e.g. C. sub coercion_export_generator { my ($class, $type, $full, $undef_msg) = @_; - return sub { + return defer_sub undef, sub { my ($value) = @_; # we need a type object - my $tobj = find_type_constraint($full) or croak $undef_msg; - my $return = $tobj->coerce($value); + my $tobj = find_type_constraint($full); - # non-successful coercion returns false - return unless $tobj->check($return); + return sub { + croak $undef_msg unless $tobj; - return $return; + my $return = $tobj->coerce($_[0]); + + # non-successful coercion returns false + return unless $tobj->check($return); + + return $return; + }; } } @@ -508,13 +514,20 @@ Generates a constraint check closure, e.g. C. sub check_export_generator { my ($class, $type, $full, $undef_msg) = @_; - return sub { + + return defer_sub undef, sub { my ($value) = @_; # we need a type object - my $tobj = find_type_constraint($full) or croak $undef_msg; - - return $tobj->check($value); + my $tobj = find_type_constraint($full); + + # This method will actually compile an inlined sub if possible. If + # not, it will return something like sub { $tobj->check($_[0]) } + # + # If $tobj is undef, we delay the croaking until the check is + # actually used for backward compatibility reasons. See + # RT #119534. + return $tobj ? $tobj->_compiled_type_constraint : sub { croak $undef_msg}; } } diff --git a/t/27-sub-defer.t b/t/27-sub-defer.t new file mode 100644 index 0000000..70c2c9a --- /dev/null +++ b/t/27-sub-defer.t @@ -0,0 +1,35 @@ +use strict; +use warnings; + +use Test::More 0.88; +use if $ENV{AUTHOR_TESTING}, 'Test::Warnings'; + +use Test::Fatal; +use B::Deparse; +use MooseX::Types::Moose qw( Int ); +use Sub::Defer qw( undefer_all ); + +like( + B::Deparse->new->coderef2text( \&is_Int ), + qr/package Sub::Defer/, + 'is_Int sub has not yet been undeferred' +); +is( + exception { undefer_all() }, + undef, + 'Sub::Defer::undefer_all works with subs exported by MooseX::Types' +); + +{ + package MyTypes; + + use MooseX::Types -declare => ['Unused']; +} + +is( + exception { undefer_all() }, + undef, + 'Sub::Defer::undefer_all does not throw an exception with unused type declaration' +); + +done_testing();