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