Commit | Line | Data |
b2b106d7 |
1 | #!/usr/bin/perl |
c47cf415 |
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; |
b2b106d7 |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
c47cf415 |
9 | use Test::More; |
10 | $TODO = q{Mouse is not yet completed}; |
b2b106d7 |
11 | use Test::Exception; |
12 | |
13 | use Mouse::Util::TypeConstraints; |
14 | |
15 | my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]'); |
16 | isa_ok($type, 'Mouse::Meta::TypeConstraint'); |
c47cf415 |
17 | isa_ok($type, 'Mouse::Meta::TypeConstraint'); |
b2b106d7 |
18 | |
19 | ok( $type->equals($type), "equals self" ); |
20 | ok( !$type->equals($type->parent), "not equal to parent" ); |
21 | ok( !$type->equals(find_type_constraint("Maybe")), "not equal to Maybe" ); |
22 | ok( $type->parent->equals(find_type_constraint("Maybe")), "parent is Maybe" ); |
c47cf415 |
23 | ok( $type->equals( Mouse::Meta::TypeConstraint->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" ); |
24 | ok( !$type->equals( Mouse::Meta::TypeConstraint->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Str") ) ), "not equal to clone with diff param" ); |
b2b106d7 |
25 | ok( !$type->equals( Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Str]') ), "not equal to declarative version of diff param" ); |
26 | |
27 | ok($type->check(10), '... checked type correctly (pass)'); |
28 | ok($type->check(undef), '... checked type correctly (pass)'); |
29 | ok(!$type->check('Hello World'), '... checked type correctly (fail)'); |
30 | ok(!$type->check([]), '... checked type correctly (fail)'); |
31 | |
32 | { |
33 | package Bar; |
34 | use Mouse; |
35 | |
36 | package Foo; |
37 | use Mouse; |
38 | use Mouse::Util::TypeConstraints; |
39 | |
40 | has 'arr' => (is => 'rw', isa => 'Maybe[ArrayRef]', required => 1); |
41 | has 'bar' => (is => 'rw', isa => class_type('Bar')); |
42 | has 'maybe_bar' => (is => 'rw', isa => maybe_type(class_type('Bar'))); |
43 | } |
44 | |
45 | lives_ok { |
46 | Foo->new(arr => [], bar => Bar->new); |
47 | } '... Bar->new isa Bar'; |
48 | |
49 | dies_ok { |
50 | Foo->new(arr => [], bar => undef); |
51 | } '... undef isnta Bar'; |
52 | |
53 | lives_ok { |
54 | Foo->new(arr => [], maybe_bar => Bar->new); |
55 | } '... Bar->new isa maybe(Bar)'; |
56 | |
57 | lives_ok { |
58 | Foo->new(arr => [], maybe_bar => undef); |
59 | } '... undef isa maybe(Bar)'; |
60 | |
61 | dies_ok { |
62 | Foo->new(arr => [], maybe_bar => 1); |
63 | } '... 1 isnta maybe(Bar)'; |
64 | |
65 | lives_ok { |
66 | Foo->new(arr => []); |
67 | } '... it worked!'; |
68 | |
69 | lives_ok { |
70 | Foo->new(arr => undef); |
71 | } '... it worked!'; |
72 | |
73 | dies_ok { |
74 | Foo->new(arr => 100); |
75 | } '... failed the type check'; |
76 | |
77 | dies_ok { |
78 | Foo->new(arr => 'hello world'); |
79 | } '... failed the type check'; |
80 | |
81 | |
82 | { |
85476837 |
83 | package Test::MouseX::Types::Maybe; |
b2b106d7 |
84 | use Mouse; |
85 | |
86 | has 'Maybe_Int' => (is=>'rw', isa=>'Maybe[Int]'); |
87 | has 'Maybe_ArrayRef' => (is=>'rw', isa=>'Maybe[ArrayRef]'); |
88 | has 'Maybe_HashRef' => (is=>'rw', isa=>'Maybe[HashRef]'); |
89 | has 'Maybe_ArrayRefInt' => (is=>'rw', isa=>'Maybe[ArrayRef[Int]]'); |
90 | has 'Maybe_HashRefInt' => (is=>'rw', isa=>'Maybe[HashRef[Int]]'); |
91 | } |
92 | |
85476837 |
93 | ok my $obj = Test::MouseX::Types::Maybe->new |
b2b106d7 |
94 | => 'Create good test object'; |
95 | |
96 | ## Maybe[Int] |
97 | |
98 | ok my $Maybe_Int = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]') |
99 | => 'made TC Maybe[Int]'; |
100 | |
101 | ok $Maybe_Int->check(1) |
102 | => 'passed (1)'; |
103 | |
104 | ok $obj->Maybe_Int(1) |
105 | => 'assigned (1)'; |
106 | |
107 | ok $Maybe_Int->check() |
108 | => 'passed ()'; |
109 | |
110 | ok $obj->Maybe_Int() |
111 | => 'assigned ()'; |
112 | |
113 | ok $Maybe_Int->check(0) |
114 | => 'passed (0)'; |
115 | |
116 | ok defined $obj->Maybe_Int(0) |
117 | => 'assigned (0)'; |
118 | |
119 | ok $Maybe_Int->check(undef) |
120 | => 'passed (undef)'; |
121 | |
122 | ok sub {$obj->Maybe_Int(undef); 1}->() |
123 | => 'assigned (undef)'; |
124 | |
125 | ok !$Maybe_Int->check("") |
126 | => 'failed ("")'; |
127 | |
128 | throws_ok sub { $obj->Maybe_Int("") }, |
129 | qr/Attribute \(Maybe_Int\) does not pass the type constraint/ |
130 | => 'failed assigned ("")'; |
131 | |
132 | ok !$Maybe_Int->check("a") |
133 | => 'failed ("a")'; |
134 | |
135 | throws_ok sub { $obj->Maybe_Int("a") }, |
136 | qr/Attribute \(Maybe_Int\) does not pass the type constraint/ |
137 | => 'failed assigned ("a")'; |
c47cf415 |
138 | |
139 | done_testing; |