1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
use Moo::_strictures;
use Test::More;
use Test::Fatal;
{
package IntConstraint;
use Moo;
use overload '&{}' => sub { shift->constraint }, fallback => 1;
has constraint => (
is => 'ro',
default => sub {
sub { $_[0] eq int $_[0] or die }
},
);
sub check {
my $self = shift;
!!eval { $self->constraint->(@_); 1 }
}
}
# First supported interface for coerce=>1.
# The type constraint provides an $isa->coerce($value) method.
{
package IntConstraint::WithCoerceMethod;
use Moo;
extends qw(IntConstraint);
sub coerce {
my $self = shift;
int($_[0]);
}
}
# First supported interface for coerce=>1.
# The type constraint provides an $isa->coercion method
# providing a coderef such that $coderef->($value) coerces.
{
package IntConstraint::WithCoercionMethod;
use Moo;
extends qw(IntConstraint);
has coercion => (
is => 'ro',
default => sub {
sub { int($_[0]) }
},
);
}
{
package Goo;
use Moo;
::like(::exception {
has foo => (
is => 'ro',
isa => sub { $_[0] eq int $_[0] },
coerce => 1,
);
}, qr/Invalid coercion/,
'coerce => 1 not allowed when isa has no coercion');
::like(::exception {
has foo => (
is => 'ro',
isa => IntConstraint->new,
coerce => 1,
);
}, qr/Invalid coercion/,
'coerce => 1 not allowed when isa has no coercion');
has bar => (
is => 'ro',
isa => IntConstraint::WithCoercionMethod->new,
coerce => 1,
);
has baz => (
is => 'ro',
isa => IntConstraint::WithCoerceMethod->new,
coerce => 1,
);
}
my $obj = Goo->new(
bar => 3.14159,
baz => 3.14159,
);
is($obj->bar, '3', '$isa->coercion');
is($obj->baz, '3', '$isa->coerce');
done_testing;
|
