Commit | Line | Data |
595edbcf |
1 | #!perl |
2 | use strict; |
3 | use warnings FATAL => 'all'; |
1a52f2db |
4 | use Test::More |
5 | eval { require Moose } |
6 | ? (tests => 25) |
7 | : (skip_all => "Moose required for testing types") |
8 | ; |
595edbcf |
9 | use Test::Fatal; |
10 | use Function::Parameters qw(:strict); |
11 | |
12 | my $o = bless {} => 'Foo'; |
13 | |
14 | { |
1a52f2db |
15 | my %meths = ( |
16 | rest_list => method ($foo, $bar, @rest) { |
595edbcf |
17 | return join q{,}, @rest; |
18 | }, |
1a52f2db |
19 | rest_named => method ($foo, $bar, %rest) { |
66265770 |
20 | return join q{,}, map { $_ => $rest{$_} } sort keys %rest; |
595edbcf |
21 | }, |
22 | ); |
23 | |
1a52f2db |
24 | for my $meth_name (keys %meths) { |
25 | my $meth = $meths{$meth_name}; |
26 | like(exception { $o->$meth() }, qr/Not enough arguments/, "$meth_name dies without args"); |
27 | like(exception { $o->$meth('foo') }, qr/Not enough arguments/, "$meth_name dies with one arg"); |
595edbcf |
28 | |
29 | is(exception { |
1a52f2db |
30 | is($o->$meth('foo', 'bar'), q{}, "$meth_name - empty \@rest list"); |
31 | }, undef, '...and validates'); |
595edbcf |
32 | |
33 | is(exception { |
1a52f2db |
34 | is($o->$meth('foo', 'bar', 1 .. 6), q{1,2,3,4,5,6}, |
35 | "$meth_name - non-empty \@rest list"); |
36 | }, undef, '...and validates'); |
595edbcf |
37 | } |
38 | } |
39 | |
40 | { |
1a52f2db |
41 | my $meth = method (Str $foo, Int $bar, Int @rest) { |
595edbcf |
42 | return join q{,}, @rest; |
43 | }; |
44 | |
45 | is(exception { |
1a52f2db |
46 | is($o->$meth('foo', 42), q{}, 'empty @rest list passed through'); |
47 | }, undef, '...and validates'); |
595edbcf |
48 | |
49 | is(exception { |
1a52f2db |
50 | is($o->$meth('foo', 42, 23, 13), q{23,13}, 'non-empty int @rest list passed through'); |
51 | }, undef, '...and validates'); |
595edbcf |
52 | |
1a52f2db |
53 | like(exception { |
54 | $o->$meth('foo', 42, 'moo', 13, 'non-empty str @rest list passed through'); |
55 | }, qr/\@rest\b.+\bValidation failed/, "...and doesn't validate"); |
595edbcf |
56 | } |
57 | |
58 | { |
1a52f2db |
59 | my $meth = method (ArrayRef[Int] @foo) { |
595edbcf |
60 | return join q{,}, map { @{ $_ } } @foo; |
61 | }; |
62 | |
63 | is(exception { |
1a52f2db |
64 | is($o->$meth([42, 23], [12], [18]), '42,23,12,18', 'int lists passed through'); |
65 | }, undef, '...and validates'); |
595edbcf |
66 | |
1a52f2db |
67 | like(exception { |
68 | $o->$meth([42, 23], 12, [18]); |
69 | }, qr/Validation failed/, "int doesn't validate against int list"); |
595edbcf |
70 | } |
71 | |
72 | { |
1a52f2db |
73 | my $meth = method (Str $foo, Int @_rest) {}; |
74 | is(exception { $meth->($o, 'foo') }, undef, 'empty unnamed list validates'); |
75 | is(exception { $meth->($o, 'foo', 42) }, undef, '1 element of unnamed list validates'); |
76 | is(exception { $meth->($o, 'foo', 42, 23) }, undef, '2 elements of unnamed list validates'); |
595edbcf |
77 | } |
78 | |
98e6239b |
79 | { |
80 | eval 'my $meth = method (:$foo, :@bar) { }'; |
1a52f2db |
81 | like $@, qr/\bnamed\b.+\bbar\b.+\barray\b/, |
82 | 'arrays or hashes cannot be named'; |
98e6239b |
83 | |
84 | eval 'my $meth = method ($foo, @bar, :$baz) { }'; |
1a52f2db |
85 | like $@, qr/\bbar\b.+\bbaz\b/, |
86 | 'named parameters cannot be combined with slurpy positionals'; |
98e6239b |
87 | } |