2 # This is automatically generated by author/import-moose-test.pl.
3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
4 use t::lib::MooseCompat;
10 $TODO = q{Mouse is not yet completed};
13 use Mouse::Util::TypeConstraints;
15 # some simple type dispatching ...
19 => where { scalar @{$_} == 0 };
23 Null => sub { die "Cannot get the head of Null" },
24 ArrayRef => sub { $_->[0] };
29 Null => sub { die "Cannot get the tail of Null" },
30 ArrayRef => sub { [ @{ $_ }[ 1 .. $#{ $_ } ] ] };
36 ArrayRef => sub { len( tail( $_ ) ) + 1 };
42 ArrayRef => sub { [ @{ rev( tail( $_ ) ) }, head( $_ ) ] };
45 is( len( [] ), 0, '... got the right length');
46 is( len( [ 1 ] ), 1, '... got the right length');
47 is( len( [ 1 .. 5 ] ), 5, '... got the right length');
48 is( len( [ 1 .. 50 ] ), 50, '... got the right length');
53 '... got the right reversed value'
56 # break down a Maybe Type ...
62 'Undef' => sub { 'undef' },
69 is( break_it_down( 'FOO' ), 'FOO', '... got the right value');
70 is( break_it_down( [] ), 'default', '... got the right value');
71 is( break_it_down( undef ), 'undef', '... got the right value');
72 is( break_it_down(), 'undef', '... got the right value');
74 # checking against enum types
76 enum RGB => qw[ red green blue ];
77 enum CMYK => qw[ cyan magenta yellow black ];
79 sub is_acceptable_color {
81 'RGB' => sub { 'RGB' },
82 'CMYK' => sub { 'CMYK' },
83 sub { die "bad color $_" };
86 is( is_acceptable_color( 'blue' ), 'RGB', '... got the right value');
87 is( is_acceptable_color( 'green' ), 'RGB', '... got the right value');
88 is( is_acceptable_color( 'red' ), 'RGB', '... got the right value');
89 is( is_acceptable_color( 'cyan' ), 'CMYK', '... got the right value');
90 is( is_acceptable_color( 'magenta' ), 'CMYK', '... got the right value');
91 is( is_acceptable_color( 'yellow' ), 'CMYK', '... got the right value');
92 is( is_acceptable_color( 'black' ), 'CMYK', '... got the right value');
95 is_acceptable_color( 'orange' )
96 } '... got the exception';
98 ## using it in an OO context
103 use Mouse::Util::TypeConstraints;
109 default => sub { __PACKAGE__->new },
110 predicate => 'has_next'
115 match_on_type $list =>
118 where { ! $_->has_next }
120 'LinkedList' => sub { '[' . $_->next->pprint . ']' };
124 my $l = LinkedList->new;
125 is($l->pprint, '[]', '... got the right pprint');
127 is($l->pprint, '[[]]', '... got the right pprint');
129 is($l->pprint, '[[[]]]', '... got the right pprint');
130 $l->next->next->next;
131 is($l->pprint, '[[[[]]]]', '... got the right pprint');
139 sub to_string { 'Foo()' }
149 '{ ' . (join ", " => map {
150 $_ . ' => ' . ppprint( $hash->{ $_ } )
151 } sort keys %$hash ) . ' }' },
154 '[ ' . (join ", " => map { ppprint( $_ ) } @$array ) . ' ]' },
155 CodeRef => sub { 'sub { ... }' },
156 RegexpRef => sub { 'qr/' . $_ . '/' },
157 GlobRef => sub { '*' . B::svref_2object($_)->NAME },
158 Object => sub { $_->can('to_string') ? $_->to_string : $_ },
159 ScalarRef => sub { '\\' . ppprint( ${$_} ) },
161 Str => sub { '"'. $_ . '"' },
162 Undef => sub { 'undef' },
163 => sub { die "I don't know what $_ is" };
169 one => [ 1, 2, "three", 4, "five", \(my $x = "six") ],
171 three => sub { "OH HAI" },
177 '{ five => *ppprint, four => qr/(?-xism:.*?)/, one => [ 1, 2, "three", 4, "five", \"six" ], six => Foo(), three => sub { ... }, two => undef }',
178 '... got the right pretty printed values'
181 # simple JSON serializer
188 '{ ' . (join ", " => map {
189 '"' . $_ . '" : ' . to_json( $hash->{ $_ } )
190 } sort keys %$hash ) . ' }' },
193 '[ ' . (join ", " => map { to_json( $_ ) } @$array ) . ' ]' },
195 Str => sub { '"'. $_ . '"' },
196 Undef => sub { 'null' },
197 => sub { die "$_ is not acceptable json type" };
201 to_json( { one => 1, two => 2 } ),
202 '{ "one" : 1, "two" : 2 }',
203 '... got our valid JSON'
208 one => [ 1, 2, 3, 4 ],
210 three => "Hello World"
212 '{ "one" : [ 1, 2, 3, 4 ], "three" : "Hello World", "two" : null }',
213 '... got our valid JSON'
219 sub not_enough_matches {
222 Undef => sub { 'hello undef world' },
223 CodeRef => sub { $_->('Hello code ref world') };
227 not_enough_matches( [] )
228 } qr/No cases matched for /, '... not enough matches';