Commit | Line | Data |
700071de |
1 | #!perl |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | |
6 | use Test::More |
7 | eval { require Moose; 1 } |
8 | ? () |
9 | : (skip_all => "Moose required for testing types") |
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' } , |
41 | ## ScalarRef[X] not implemented in Mouse, so this test is moved to typeload_moose.t |
42 | ## if Mouse starts supporting it, the test could be restored here |
43 | paramized_sref => 'ScalarRef[Num]' => \42 => \'thing' , |
44 | int_or_aref => 'Int|ArrayRef[Int]' => [ 42 , [42 ] ] => 'foo' , |
45 | ); |
46 | |
47 | |
48 | our $tester; |
49 | { |
50 | package TypeCheck::Class; |
51 | |
52 | use Test::More; |
53 | use Test::Fatal; |
54 | |
55 | method new ($class:) { bless {}, $class; } |
56 | |
57 | sub _list { return ref $_[0] eq 'ARRAY' ? @{$_[0]} : ( $_[0] ); } |
58 | |
59 | |
60 | $tester = __PACKAGE__->new; |
61 | while (@TYPES) |
62 | { |
63 | my ($name, $type, $goodval, $badval) = splice @TYPES, 0, 4; |
64 | note "name/type/goodval/badval $name/$type/$goodval/$badval"; |
65 | my $method = "check_$name"; |
66 | no strict 'refs'; |
67 | |
68 | # make sure the declaration of the method doesn't throw a warning |
69 | is eval qq{ method $method ($type \$bar) {} 42 }, 42; |
70 | is $@, ''; |
71 | |
72 | # positive test--can we call it with a good value? |
73 | my @vals = _list($goodval); |
74 | my $count = 1; |
75 | foreach (@vals) |
76 | { |
77 | my $tag = @vals ? ' (alternative ' . $count++ . ')' : ''; |
78 | is exception { $tester->$method($_) }, undef, "call with good value for $name passes" . $tag; |
79 | } |
80 | |
81 | # negative test--does calling it with a bad value throw an exception? |
82 | @vals = _list($badval); |
83 | $count = 1; |
84 | foreach (@vals) |
85 | { |
86 | my $tag = @vals ? ' (#' . $count++ . ')' : ''; |
87 | like exception { $tester->$method($_) }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, |
88 | "call with bad value for $name dies"; |
89 | } |
90 | } |
91 | |
92 | |
93 | # try some mixed (i.e. some with a type, some without) and multiples |
94 | |
95 | my $method = 'check_mixed_type_first'; |
96 | is eval qq{ method $method (Int \$bar, \$baz) {} 42 }, 42; |
97 | is exception { $tester->$method(0, 'thing') }, undef, 'call with good values (type, notype) passes'; |
98 | like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, |
99 | 'call with bad values (type, notype) dies'; |
100 | |
101 | $method = 'check_mixed_type_second'; |
102 | is eval qq{ method $method (\$bar, Int \$baz) {} 42 }, 42; |
103 | is exception { $tester->$method('thing', 1) }, undef, 'call with good values (notype, type) passes'; |
104 | like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 2\b.+\$baz\b.+Validation failed for '[^']+' with value\b/, |
105 | 'call with bad values (notype, type) dies'; |
106 | |
107 | $method = 'check_multiple_types'; |
108 | is eval qq{ method $method (Int \$bar, Int \$baz) {} 42 }, 42; |
109 | is exception { $tester->$method(1, 1) }, undef, 'call with good values (type, type) passes'; |
110 | # with two types, and bad values for both, they should fail in order of declaration |
111 | like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, |
112 | 'call with bad values (type, type) dies'; |
113 | |
114 | # want to try one with undef as well to make sure we don't get an uninitialized warning |
115 | |
116 | like exception { $tester->check_int(undef) }, qr/method check_int.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, |
117 | 'call with bad values (undef) dies'; |
118 | |
119 | |
120 | |
121 | # finally, some types that shouldn't be recognized |
122 | my $type; |
123 | |
124 | #$method = 'unknown_type'; |
125 | #$type = 'Bmoogle'; |
126 | #is eval qq{ method $method ($type \$bar) {} 42 }, 42; |
127 | #like exception { $tester->$method(42) }, qr/ducks $tester, $type, "perhaps you forgot to load it?", $method/, |
128 | # 'call with unrecognized type dies'; |
129 | |
130 | # this one is a bit specialer in that it involved an unrecognized parameterization |
131 | $method = 'unknown_paramized_type'; |
132 | $type = 'Bmoogle[Int]'; |
133 | is eval qq{ method $method ($type \$bar) {} 42 }, undef; |
134 | like $@, qr/\QCould not locate the base type (Bmoogle)/; |
135 | like exception { $tester->$method(42) }, qr/\QCan't locate object method "unknown_paramized_type" via package "TypeCheck::Class"/; |
136 | } |
137 | |
138 | |
139 | done_testing; |