From e21317870e7e11531a01487f582d81aae4cd95fd Mon Sep 17 00:00:00 2001 From: Dave Rolsky Date: Wed, 25 Jan 2017 13:12:27 -0500 Subject: [PATCH] Set sub names when calling defer_sub --- lib/MooseX/Types.pm | 8 ++++---- lib/MooseX/Types/Base.pm | 18 ++++++++++++++---- t/27-sub-defer.t | 28 ++++++++++++++++++++++++++++ 3 files changed, 46 insertions(+), 8 deletions(-) create mode 100644 t/27-sub-defer.t diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm index aa8d3af..200010e 100644 --- a/lib/MooseX/Types.pm +++ b/lib/MooseX/Types.pm @@ -486,8 +486,8 @@ This generates a coercion handler function, e.g. C. =cut sub coercion_export_generator { - my ($class, $type, $full, $undef_msg) = @_; - return defer_sub undef, sub { + my ($class, $sub_name, $type, $full, $undef_msg) = @_; + return defer_sub $sub_name, sub { my ($value) = @_; # we need a type object @@ -511,9 +511,9 @@ Generates a constraint check closure, e.g. C. =cut sub check_export_generator { - my ($class, $type, $full, $undef_msg) = @_; + my ($class, $sub_name, $type, $full, $undef_msg) = @_; - return defer_sub undef, sub { + return defer_sub $sub_name, sub { my ($value) = @_; # we need a type object diff --git a/lib/MooseX/Types/Base.pm b/lib/MooseX/Types/Base.pm index 92a2c06..780d231 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..a73eef9 --- /dev/null +++ b/t/27-sub-defer.t @@ -0,0 +1,28 @@ +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' +); + +done_testing();