Commit | Line | Data |
700071de |
1 | #!perl |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | |
6 | use Test::More |
8d34f4d9 |
7 | eval { require Moose } |
1a52f2db |
8 | ? () |
9 | : (skip_all => "Moose required for testing types") |
700071de |
10 | ; |
11 | use Test::More; |
12 | use Test::Fatal; |
13 | |
14 | use Function::Parameters qw(:strict); |
15 | |
16 | |
17 | { package Foo::Bar; sub new { bless {}, __PACKAGE__; } } |
18 | { package Foo::Baz; sub new { bless {}, __PACKAGE__; } } |
19 | |
20 | our $foobar = Foo::Bar->new; |
21 | our $foobaz = Foo::Baz->new; |
22 | |
23 | |
24 | # types to check below |
25 | # the test name needs to be interpolated into a method name, so it must be a valid identifier |
26 | # either good value or bad value can be an array reference: |
27 | # * if it is, it is taken to be multiple values to try |
28 | # * if you want to pass an array reference, you have to put it inside another array reference |
29 | # * so, [ 42, undef ] makes two calls: one with 42, and one with undef |
30 | # * but [[ 42, undef ]] makes one call, passing [ 42, undef ] |
31 | our @TYPES = |
32 | ( |
33 | ## Test Name => Type => Good Value => Bad Value |
34 | int => 'Int' => 42 => 'foo' , |
35 | bool => 'Bool' => 0 => 'fool' , |
36 | aref => 'ArrayRef', => [[ 42, undef ]] => 42 , |
37 | class => 'Foo::Bar' => $foobar => $foobaz , |
38 | maybe_int => 'Maybe[Int]' => [ 42, undef ] => 'foo' , |
39 | paramized_aref => 'ArrayRef[Num]' => [[ 6.5, 42, 1e23 ]] => [[ 6.5, 42, 'thing' ]] , |
40 | paramized_href => 'HashRef[Num]' => { a => 6.5, b => 2, c => 1e23 } => { a => 6.5, b => 42, c => 'thing' } , |
1a52f2db |
41 | paramized_nested=> 'HashRef[ArrayRef[Int]]' |
42 | => { foo=>[1..3], bar=>[1] } => { foo=>['a'] } , |
700071de |
43 | ## ScalarRef[X] not implemented in Mouse, so this test is moved to typeload_moose.t |
44 | ## if Mouse starts supporting it, the test could be restored here |
45 | paramized_sref => 'ScalarRef[Num]' => \42 => \'thing' , |
46 | int_or_aref => 'Int|ArrayRef[Int]' => [ 42 , [42 ] ] => 'foo' , |
1a52f2db |
47 | int_or_aref_or_undef |
48 | => 'Int|ArrayRef[Int]|Undef' |
49 | => [ 42 , [42 ], undef ] => 'foo' , |
700071de |
50 | ); |
51 | |
52 | |
53 | our $tester; |
54 | { |
55 | package TypeCheck::Class; |
56 | |
1a52f2db |
57 | use strict; |
58 | use warnings; |
59 | |
700071de |
60 | use Test::More; |
61 | use Test::Fatal; |
62 | |
1a52f2db |
63 | use Function::Parameters qw(:strict); |
64 | |
700071de |
65 | method new ($class:) { bless {}, $class; } |
66 | |
67 | sub _list { return ref $_[0] eq 'ARRAY' ? @{$_[0]} : ( $_[0] ); } |
68 | |
69 | |
70 | $tester = __PACKAGE__->new; |
71 | while (@TYPES) |
72 | { |
73 | my ($name, $type, $goodval, $badval) = splice @TYPES, 0, 4; |
74 | note "name/type/goodval/badval $name/$type/$goodval/$badval"; |
75 | my $method = "check_$name"; |
76 | no strict 'refs'; |
77 | |
78 | # make sure the declaration of the method doesn't throw a warning |
79 | is eval qq{ method $method ($type \$bar) {} 42 }, 42; |
1a52f2db |
80 | is $@, ''; |
700071de |
81 | |
82 | # positive test--can we call it with a good value? |
83 | my @vals = _list($goodval); |
84 | my $count = 1; |
85 | foreach (@vals) |
86 | { |
87 | my $tag = @vals ? ' (alternative ' . $count++ . ')' : ''; |
88 | is exception { $tester->$method($_) }, undef, "call with good value for $name passes" . $tag; |
89 | } |
90 | |
91 | # negative test--does calling it with a bad value throw an exception? |
92 | @vals = _list($badval); |
93 | $count = 1; |
94 | foreach (@vals) |
95 | { |
96 | my $tag = @vals ? ' (#' . $count++ . ')' : ''; |
97 | like exception { $tester->$method($_) }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, |
98 | "call with bad value for $name dies"; |
99 | } |
100 | } |
101 | |
102 | |
103 | # try some mixed (i.e. some with a type, some without) and multiples |
104 | |
105 | my $method = 'check_mixed_type_first'; |
106 | is eval qq{ method $method (Int \$bar, \$baz) {} 42 }, 42; |
107 | is exception { $tester->$method(0, 'thing') }, undef, 'call with good values (type, notype) passes'; |
108 | like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, |
109 | 'call with bad values (type, notype) dies'; |
110 | |
111 | $method = 'check_mixed_type_second'; |
112 | is eval qq{ method $method (\$bar, Int \$baz) {} 42 }, 42; |
113 | is exception { $tester->$method('thing', 1) }, undef, 'call with good values (notype, type) passes'; |
114 | like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 2\b.+\$baz\b.+Validation failed for '[^']+' with value\b/, |
115 | 'call with bad values (notype, type) dies'; |
116 | |
117 | $method = 'check_multiple_types'; |
118 | is eval qq{ method $method (Int \$bar, Int \$baz) {} 42 }, 42; |
119 | is exception { $tester->$method(1, 1) }, undef, 'call with good values (type, type) passes'; |
120 | # with two types, and bad values for both, they should fail in order of declaration |
121 | like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, |
122 | 'call with bad values (type, type) dies'; |
123 | |
124 | # want to try one with undef as well to make sure we don't get an uninitialized warning |
125 | |
126 | like exception { $tester->check_int(undef) }, qr/method check_int.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, |
127 | 'call with bad values (undef) dies'; |
128 | |
129 | |
130 | |
131 | # finally, some types that shouldn't be recognized |
132 | my $type; |
133 | |
134 | #$method = 'unknown_type'; |
135 | #$type = 'Bmoogle'; |
136 | #is eval qq{ method $method ($type \$bar) {} 42 }, 42; |
137 | #like exception { $tester->$method(42) }, qr/ducks $tester, $type, "perhaps you forgot to load it?", $method/, |
138 | # 'call with unrecognized type dies'; |
139 | |
140 | # this one is a bit specialer in that it involved an unrecognized parameterization |
141 | $method = 'unknown_paramized_type'; |
142 | $type = 'Bmoogle[Int]'; |
143 | is eval qq{ method $method ($type \$bar) {} 42 }, undef; |
1a52f2db |
144 | like $@, qr/\QCould not locate the base type (Bmoogle)/; |
700071de |
145 | like exception { $tester->$method(42) }, qr/\QCan't locate object method "unknown_paramized_type" via package "TypeCheck::Class"/; |
1a52f2db |
146 | |
700071de |
147 | } |
148 | |
149 | |
150 | done_testing; |