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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
=pod
=encoding utf-8
=head1 PURPOSE
Test L<Type::Params> C<multisig> function.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
Portions by Diab Jerius E<lt>djerius@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2013-2014 by Toby Inkster.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
use strict;
use warnings;
use Test::More;
use Test::Fatal;
use Type::Params qw( multisig compile validate );
use Types::Standard qw( -types slurpy );
my $Rounded = Int->plus_coercions(Num, 'int($_)');
my $sig = multisig(
[ Int, ArrayRef[$Rounded] ],
[ ArrayRef[$Rounded], Int ],
[ HashRef[Num] ],
);
is_deeply(
[ $sig->( 1, [2,3,4] ) ],
[ 1, [2,3,4] ],
'first choice in multi, no coercion, should pass',
);
is_deeply(
[ $sig->( 1, [2.2,3.3,4.4] ) ],
[ 1, [2,3,4] ],
'first choice in multi, coercion, should pass',
);
like(
exception { $sig->( 1.1, [2.2,3.3,4.4] ) },
qr{^Parameter validation failed},
'first choice in multi, should fail',
);
is_deeply(
[ $sig->( [2,3,4], 1 ) ],
[ [2,3,4], 1 ],
'second choice in multi, no coercion, should pass',
);
is_deeply(
[ $sig->( [2.2,3.3,4.4], 1 ) ],
[ [2,3,4], 1 ],
'second choice in multi, coercion, should pass',
);
like(
exception { $sig->( [2.2,3.3,4.4], 1.1 ) },
qr{^Parameter validation failed},
'second choice in multi, should fail',
);
is_deeply(
[ $sig->( { a => 1.1, b => 7 } ) ],
[ { a => 1.1, b => 7 } ],
'third choice in multi, no coercion, should pass',
);
like(
exception { $sig->( { a => 1.1, b => 7, c => "Hello" } ) },
qr{^Parameter validation failed},
'third choice in multi, should fail',
);
my $a = Dict [ a => Num ];
my $b = Dict [ b => Num ];
is exception {
validate( [ { a => 3 } ], $a );
validate( [ a => 3 ], slurpy $a );
}, undef;
is exception {
my $check = multisig( [ $a ], [ $b ] );
$check->( { a => 3 } );
$check->( { b => 3 } );
}, undef;
is exception {
my $check = multisig( [ slurpy $a ], [ slurpy $b ] );
$check->( a => 3 );
$check->( b => 3 );
}, undef;
is exception {
my $check = multisig( compile(slurpy $a), compile(slurpy $b) );
$check->( a => 3 );
$check->( b => 3 );
}, undef;
done_testing;
|
