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