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
|
=pod
=encoding utf-8
=head1 PURPOSE
Checks various values against C<CycleTuple> from Types::Standard.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2017-2023 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 lib qw( ./lib ./t/lib ../inc ./inc );
use Test::More;
use Test::TypeTiny;
use Test::Fatal qw(exception);
use Types::Standard qw( CycleTuple Num Int HashRef ArrayRef Any Optional slurpy );
use Type::Utils qw( class_type );
my $type1 = CycleTuple[
Int->plus_coercions(Num, 'int($_)'),
HashRef,
ArrayRef,
];
my $type2 = CycleTuple[
Int->where(sub{2})->plus_coercions(Num, 'int($_)'),
HashRef,
ArrayRef,
];
my $type3 = CycleTuple[
Int->plus_coercions(Num->where(sub{2}), 'int($_)'),
HashRef,
ArrayRef,
];
my $type4 = CycleTuple[
Int->where(sub{2})->plus_coercions(Num->where(sub{2}), 'int($_)'),
HashRef,
ArrayRef,
];
my $i;
for my $type ($type1, $type2, $type3, $type4)
{
++$i;
subtest "\$type$i" => sub {
should_fail(undef, $type);
should_fail({}, $type);
should_pass([], $type);
should_fail([{}], $type);
should_fail([1], $type);
should_fail([1,{}], $type);
should_pass([1,{}, []], $type);
should_fail([1,{}, [], undef], $type);
should_fail([1,{}, [], 2], $type);
should_pass([1,{}, [], 2, {}, [1]], $type);
is_deeply(
$type->coerce([1.1, {}, [], 2.2, {}, [3.3]]),
[1, {}, [], 2, {}, [3.3]],
'automagic coercion',
);
};
}
like(
exception { CycleTuple[Any, Optional[Any]] },
qr/cannot be optional/i,
'cannot make CycleTuples with optional slots',
);
like(
exception { CycleTuple[Any, slurpy ArrayRef] },
qr/cannot be slurpy/i,
'cannot make CycleTuples with slurpy slots',
);
# should probably write a test case for this.
#diag exception { $type->assert_return([1,{},[],[],[],[]]) };
done_testing;
|
