I have inherited the following code which was written and works against Type-Tiny-1.004004:
package Company::Types;
use Type::Library -base, -declare => qw< TruncatedString >;
use Type::Utils -all;
declare TruncatedString, as Str,
where { length $_ },
inline_as {
my ($constraint, $varname) = @_;
return sprintf ( '!defined %s or %s',
$varname,
$constraint->parent->inline_check($varname),
);
},
constraint_generator => sub {
my ($max) = @_;
die q{Max length must be positive!} unless int($max) > 0;
return sub {
(length $_) <= $max;
};
},
inline_generator => sub {
my ($max) = @_;
return sub {
my ($constraint, $varname) = @_;
return sprintf(
'%s and length %s <= %d',
$constraint->parent->inline_check($varname),
$varname,
$max,
);
};
},
coercion_generator => sub {
my ($base, $derived, $max) = @_;
# $base - TruncatedString
# $derived - TruncatedString[<N>]
# $max - N
# Not sure if I should be adding the coercion to $base or $derived, but I suspect that
# $derived is the correct choice here.
$derived->coercion->add_type_coercions(Str,
sub {
return substr $_, 0, $max;
}
);
};
However it does not work against Type-Tiny-1.012000. I have written the following test to illustrate the problem:
use Test2::V0;
use Time::Out qw< timeout >;
use Company::Types qw< TruncatedString >;
subtest 'Coercing to TruncatedString->of(10)' => sub {
timeout 2 => sub { # test hangs without timeout
my $type = TruncatedString->of(10); # same as TruncatedString[10]
ok( try_ok { $type->coerce('123456789012') }, 'should not throw an exception' );
} || bail_out( 'Ran out of time: ' . $@ );
};
done_testing();
This outputs the following:
# Seeded srand with seed '20201120' from local date.
Deep recursion on subroutine "Type::Tiny::_build_coercion" at ${SRC}/company-types/.direnv/perl5/lib/perl5/Type/Tiny.pm line 399.
Deep recursion on anonymous subroutine at ${SRC}/company-types/.direnv/perl5/lib/perl5/Type/Tiny.pm line 467.
Deep recursion on anonymous subroutine at ${SRC}/company-types/.direnv/perl5/lib/perl5/Type/Tiny.pm line 1015.
not ok 1 - Coercing to TruncatedString->of(10) {
not ok 1
# Failed test at t/truncated-string.t line 8.
# Exception: CODE(0x7fee0fb78998)
not ok 2 - should not throw an exception
# Failed test 'should not throw an exception'
# at t/truncated-string.t line 8.
1..2
}
# Failed test 'Coercing to TruncatedString->of(10)'
# at t/truncated-string.t line 10.
1..1
Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/1 subtests
Test Summary Report
-------------------
t/truncated-string.t (Wstat: 256 Tests: 1 Failed: 1)
Failed test: 1
Non-zero exit status: 1
Files=1, Tests=1, 4 wallclock secs ( 0.02 usr 0.01 sys + 3.43 cusr 0.38 csys = 3.84 CPU)
Result: FAIL
I have narrowed the problem to coercion_generator
(if I comment it out I lose this error) and have noted this in the docs:
The following attributes are used for parameterized coercions, but are not fully documented because they may change in the near future:
I presume this has since changed and was hoping for some help as to how to update my existing code to catch up?
Not sure if I should be adding the coercion to $base or $derived
Neither. You should be returning it.
coercion_generator => sub {
my ($base, $derived, $max) = @_;
return Type::Coercion->new(
type_coercion_map => [ Str, sub { substr $_, 0, $max } ]
);
};
See Parameterizable Types in Type::Tiny::Manual::Libraries — it gives a pretty good explanation and example of how to do parameterized types with inlining and coercion.
I've checked the above works in the current Type::Tiny release, and even versions as old as 0.006 (released May 2013)! How you're doing it in your original code has never been the intended use of coercion_generator
and I'm kind of surprised it has ever worked.
Also, if you're interested why you're getting a warning about deep coercion, it's caused by the fact that $type->coercion
acts much like a lazy attribute in Moo/Moose, and it calls your coderef, but your coderef called $type->coercion
.