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..8b049f3 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' @@ -485,18 +486,23 @@ This generates a coercion handler function, e.g. C. =cut sub coercion_export_generator { - my ($class, $type, $full, $undef_msg) = @_; - return sub { + my ($class, $sub_name, $type, $full, $undef_msg) = @_; + return defer_sub $sub_name, 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; + }; } } @@ -507,14 +513,21 @@ Generates a constraint check closure, e.g. C. =cut sub check_export_generator { - my ($class, $type, $full, $undef_msg) = @_; - return sub { + my ($class, $sub_name, $type, $full, $undef_msg) = @_; + + return defer_sub $sub_name, 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/lib/MooseX/Types/Base.pm b/lib/MooseX/Types/Base.pm index 3600f7d..0eaccc4 100644 --- a/lib/MooseX/Types/Base.pm +++ b/lib/MooseX/Types/Base.pm @@ -53,8 +53,18 @@ sub import { # determine the wrapper, -into is supported for compatibility reasons my $wrapper = $options->{ -wrapper } || 'MooseX::Types'; - $args[0]->{into} = $options->{ -into } - if exists $options->{ -into }; + # It's a little gross to calculate the calling package here when + # Sub::Exporter is going to do it again, but we need to give Sub::Defer a + # fully qualified name if we give it a name at all, and we want to give it + # a name. Otherwise it guesses at the name and will use its caller, which + # in this case ends up being MooseX::Types, which is wrong. + my $into; + if (exists $options->{ -into }) { + $into = $args[0]->{into} = $options->{ -into } + } + else { + $into = caller(($options->{into_level} || 0) + 1) + } my %ex_util; @@ -79,7 +89,7 @@ sub import { my $check_name = "is_${type_short}"; push @{ $ex_spec{exports} }, $check_name, - sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg) }; + sub { $wrapper->check_export_generator("${into}::$check_name", $type_short, $type_full, $undef_msg) }; # only export coercion helper if full (for libraries) or coercion is defined next TYPE @@ -89,7 +99,7 @@ sub import { my $coercion_name = "to_${type_short}"; push @{ $ex_spec{exports} }, $coercion_name, - sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) }; + sub { $wrapper->coercion_export_generator("${into}::$coercion_name", $type_short, $type_full, $undef_msg) }; $ex_util{ $type_short }{to}++; # shortcut to remember this exists } diff --git a/t/27-sub-defer.t b/t/27-sub-defer.t new file mode 100644 index 0000000..0562e2f --- /dev/null +++ b/t/27-sub-defer.t @@ -0,0 +1,41 @@ +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' +); +unlike( + B::Deparse->new->coderef2text( \&is_Int ), + qr/package Sub::Defer/, + 'is_Int sub is now undeferred' +); + +{ + 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();