Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix Sub::Defer but without the sub names #8

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 4 additions & 1 deletion Changes
Original file line number Diff line number Diff line change
Expand Up @@ -2,14 +2,17 @@ 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

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
Expand Down
33 changes: 23 additions & 10 deletions lib/MooseX/Types.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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'
Expand Down Expand Up @@ -486,17 +487,22 @@ This generates a coercion handler function, e.g. C<to_Int($value)>.

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;
};
}
}

Expand All @@ -508,13 +514,20 @@ Generates a constraint check closure, e.g. C<is_Int($value)>.

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};
}
}

Expand Down
35 changes: 35 additions & 0 deletions t/27-sub-defer.t
Original file line number Diff line number Diff line change
@@ -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();