1=pod
2
3=encoding utf-8
4
5=head1 PURPOSE
6
7Checks Mouse type constraints, and L<MouseX::Types> type constraints are
8picked up by C<dwim_type> from L<Type::Utils>.
9
10=head1 DEPENDENCIES
11
12Mouse 1.00 and MouseX::Types 0.06; skipped otherwise.
13
14=head1 AUTHOR
15
16Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
17
18=head1 COPYRIGHT AND LICENCE
19
20This software is copyright (c) 2013-2014, 2017-2021 by Toby Inkster.
21
22This is free software; you can redistribute it and/or modify it under
23the same terms as the Perl 5 programming language system itself.
24
25=cut
26
27use strict;
28use warnings;
29
30use Test::More;
31use Test::Requires { "Mouse" => "1.00" };
32use Test::Requires { "MouseX::Types" => "0.06" };
33use Test::TypeTiny;
34
35use Mouse;
36use Mouse::Util::TypeConstraints qw(:all);
37use Type::Utils 0.015 qw(dwim_type);
38
39# Creating a type constraint with Mouse
40subtype "Two", as "Int", where { $_ eq 2 };
41
42my $two  = dwim_type("Two");
43my $twos = dwim_type("ArrayRef[Two]");
44
45isa_ok($two, 'Type::Tiny', '$two');
46isa_ok($twos, 'Type::Tiny', '$twos');
47
48should_pass(2, $two);
49should_fail(3, $two);
50should_pass([2, 2, 2], $twos);
51should_fail([2, 3, 2], $twos);
52
53# Creating a type constraint with MouseX::Types
54{
55	package MyTypes;
56	use MouseX::Types -declare => ["Three"];
57	use MouseX::Types::Moose "Int";
58
59	subtype Three, as Int, where { $_ eq 3 };
60
61	$INC{'MyTypes.pm'} = __FILE__;
62}
63
64# Note that MouseX::Types namespace-prefixes its types.
65my $three = dwim_type("MyTypes::Three");
66my $threes = dwim_type("ArrayRef[MyTypes::Three]");
67
68isa_ok($three, 'Type::Tiny', '$three');
69isa_ok($threes, 'Type::Tiny', '$threes');
70
71should_pass(3, $three);
72should_fail(4, $three);
73should_pass([3, 3, 3], $threes);
74should_fail([3, 4, 3], $threes);
75
76{
77	my $testclass = 'Local::Some::Class';
78	my $fallback  = dwim_type($testclass);
79	should_pass(bless({}, $testclass), $fallback);
80	should_fail(bless({}, 'main'), $fallback);
81
82	my $fallbackp = dwim_type("ArrayRef[$testclass]");
83	should_pass([bless({}, $testclass)], $fallbackp);
84	should_pass([], $fallbackp);
85	should_fail([bless({}, 'main')], $fallbackp);
86
87	my $fallbacku = dwim_type("ArrayRef[$testclass]", fallback => []);
88	is($fallbacku, undef);
89}
90
91{
92	my $testclass = 'Local::Some::Class';
93	my $fallback  = dwim_type("$testclass\::");
94	should_pass(bless({}, $testclass), $fallback);
95	should_fail(bless({}, 'main'), $fallback);
96
97	my $fallbackp = dwim_type("ArrayRef[$testclass\::]");
98	should_pass([bless({}, $testclass)], $fallbackp);
99	should_pass([], $fallbackp);
100	should_fail([bless({}, 'main')], $fallbackp);
101}
102
103
104
105done_testing;
106