1=pod
2
3=encoding utf-8
4
5=head1 PURPOSE
6
7Checks various values against C<CycleTuple> from Types::Standard.
8
9=head1 AUTHOR
10
11Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
12
13=head1 COPYRIGHT AND LICENCE
14
15This software is copyright (c) 2017-2021 by Toby Inkster.
16
17This is free software; you can redistribute it and/or modify it under
18the same terms as the Perl 5 programming language system itself.
19
20=cut
21
22use strict;
23use warnings;
24use lib qw( ./lib ./t/lib ../inc ./inc );
25
26use Test::More;
27use Test::TypeTiny;
28use Test::Fatal qw(exception);
29
30use Types::Standard qw( CycleTuple Num Int HashRef ArrayRef Any Optional slurpy );
31use Type::Utils qw( class_type );
32
33my $type1 = CycleTuple[
34	Int->plus_coercions(Num, 'int($_)'),
35	HashRef,
36	ArrayRef,
37];
38
39my $type2 = CycleTuple[
40	Int->where(sub{2})->plus_coercions(Num, 'int($_)'),
41	HashRef,
42	ArrayRef,
43];
44
45my $type3 = CycleTuple[
46	Int->plus_coercions(Num->where(sub{2}), 'int($_)'),
47	HashRef,
48	ArrayRef,
49];
50
51my $type4 = CycleTuple[
52	Int->where(sub{2})->plus_coercions(Num->where(sub{2}), 'int($_)'),
53	HashRef,
54	ArrayRef,
55];
56
57my $i;
58for my $type ($type1, $type2, $type3, $type4)
59{
60	++$i;
61	subtest "\$type$i" => sub {
62		should_fail(undef, $type);
63		should_fail({}, $type);
64		should_pass([], $type);
65		should_fail([{}], $type);
66		should_fail([1], $type);
67		should_fail([1,{}], $type);
68		should_pass([1,{}, []], $type);
69		should_fail([1,{}, [], undef], $type);
70		should_fail([1,{}, [], 2], $type);
71		should_pass([1,{}, [], 2, {}, [1]], $type);
72
73		is_deeply(
74			$type->coerce([1.1, {}, [], 2.2, {}, [3.3]]),
75			[1, {}, [], 2, {}, [3.3]],
76			'automagic coercion',
77		);
78	};
79}
80
81like(
82	exception { CycleTuple[Any, Optional[Any]] },
83	qr/cannot be optional/i,
84	'cannot make CycleTuples with optional slots',
85);
86
87like(
88	exception { CycleTuple[Any, slurpy ArrayRef] },
89	qr/cannot be slurpy/i,
90	'cannot make CycleTuples with slurpy slots',
91);
92
93# should probably write a test case for this.
94#diag exception { $type->assert_return([1,{},[],[],[],[]]) };
95
96done_testing;
97