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
150
151
152
153
|
#!perl
use strict;
use warnings FATAL => 'all';
use Test::More tests => 67;
use Test::Fatal;
use Function::Parameters;
{
package Foo;
method new($class : ) {
return bless {
x => 1,
y => 2,
z => 3,
}, $class;
}
method get_x() { $self->{x} }
method get_y($self:) { $self->{y} }
method get_z($this:) { $this->{z} }
method set_x($val) { $self->{x} = $val; }
method set_y($self:$val) { $self->{y} = $val; }
method set_z($this: $val) { $this->{z} = $val; }
}
my $o = Foo->new;
ok $o->isa('Foo'), "Foo->new->isa('Foo')";
is $o->get_x, 1;
is $o->get_y, 2;
is $o->get_z, 3;
$o->set_x("A");
$o->set_y("B");
$o->set_z("C");
is $o->get_x, "A";
is $o->get_y, "B";
is $o->get_z, "C";
is method ($x = $self) { "$self $x [@_]" }->('A'), 'A A []';
is eval { $o->get_z(42) }, undef;
like $@, qr/Too many arguments/;
is eval { $o->set_z }, undef;
like $@, qr/Too few arguments/;
is eval q{fun ($self:) {}}, undef;
like $@, qr/invocant \$self not allowed here/;
is eval q{fun ($x : $y) {}}, undef;
like $@, qr/invocant \$x not allowed here/;
is eval q{method (@x:) {}}, undef;
like $@, qr/invocant \@x can't be an array/;
is eval q{method (%x:) {}}, undef;
like $@, qr/invocant %x can't be a hash/;
is eval q{method ($x, $y:) {}}, undef;
like $@, qr/\Qnumber of invocants in parameter list (2) differs from number of invocants in keyword definition (1)/;
{
use Function::Parameters {
def => {
invocant => 1,
strict => 0,
}
};
def foo1($x) { join ' ', $x, @_ }
def foo2($x: $y) { join ' ', $x, $y, @_ }
def foo3($x, $y) { join ' ', $x, $y, @_ }
is foo1("a"), "a a";
is foo2("a", "b"), "a b b";
is foo3("a", "b"), "a b a b";
is foo1("a", "b"), "a a b";
is foo2("a", "b", "c"), "a b b c";
is foo3("a", "b", "c"), "a b a b c";
}
use Function::Parameters {
method2 => {
defaults => 'method',
shift => ['$self1', '$self2' ],
},
};
method2 m2_a($x) { "$self1 $self2 $x [@_]" }
is m2_a('a', 'b', 'c'), 'a b c [c]';
for my $info (Function::Parameters::info(\&m2_a)) {
my @inv = $info->invocants;
is_deeply \@inv, [qw($self1 $self2)];
is_deeply [map $_->name, @inv], [qw($self1 $self2)];
is_deeply [map $_->type, @inv], [undef, undef];
is $info->args_min, 3;
is $info->args_max, 3;
like exception { $info->invocant }, qr/single invocant/;
}
method2 m2_b($x = $self2, $y = $self1) { "$self1 $self2 $x $y [@_]" }
like exception { m2_b('a', 'b', 'c', 'd', 'e') }, qr/^\QToo many arguments for method2 m2_b (expected 4, got 5)/;
is m2_b('a', 'b', 'c', 'd'), 'a b c d [c d]';
is m2_b('a', 'b', 'c'), 'a b c a [c]';
is m2_b('a', 'b'), 'a b b a []';
like exception { m2_b('a') }, qr/^\QToo few arguments for method2 m2_b (expected 2, got 1)/;
for my $info (Function::Parameters::info(\&m2_b)) {
my @inv = $info->invocants;
is_deeply \@inv, [qw($self1 $self2)];
is_deeply [map $_->name, @inv], [qw($self1 $self2)];
is_deeply [map $_->type, @inv], [undef, undef];
is $info->args_min, 2;
is $info->args_max, 4;
like exception { $info->invocant }, qr/single invocant/;
}
method2 m2_c($t1, $t2:) { "$t1 $t2 [@_]" }
like exception { m2_c('a', 'b', 'c') }, qr/^\QToo many arguments for method2 m2_c (expected 2, got 3)/;
is m2_c('a', 'b'), 'a b []';
like exception { m2_c('a') }, qr/^\QToo few arguments for method2 m2_c (expected 2, got 1)/;
for my $info (Function::Parameters::info(\&m2_c)) {
my @inv = $info->invocants;
is_deeply \@inv, [qw($t1 $t2)];
is_deeply [map $_->name, @inv], [qw($t1 $t2)];
is_deeply [map $_->type, @inv], [undef, undef];
is $info->args_min, 2;
is $info->args_max, 2;
like exception { $info->invocant }, qr/single invocant/;
}
is eval('method2 ($t1, $t2:) { $self1 }'), undef;
like $@, qr/^Global symbol "\$self1" requires explicit package name/;
is eval('method2 ($self1) {}'), undef;
like $@, qr/\$self1 can't appear twice in the same parameter list/;
is eval('method2 ($x, $self2) {}'), undef;
like $@, qr/\$self2 can't appear twice in the same parameter list/;
is eval('method2 m2_z($self: $x) {} 1'), undef;
like $@, qr/^\QIn method2 m2_z: number of invocants in parameter list (1) differs from number of invocants in keyword definition (2)/;
ok !exists &m2_z;
is eval('method2 m2_z($orig, $self, $x: $y) {} 1'), undef;
like $@, qr/^\QIn method2 m2_z: number of invocants in parameter list (3) differs from number of invocants in keyword definition (2)/;
ok !exists &m2_z;
|
