-
Notifications
You must be signed in to change notification settings - Fork 135
/
multi.t
214 lines (172 loc) · 5.62 KB
/
multi.t
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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
use v6;
use Test;
plan 32;
# L<S12/"Multisubs and Multimethods">
# L<S12/"Trusts">
class Foo {
multi method bar() {
return "Foo.bar() called with no args";
}
multi method bar(Str $str) {
return "Foo.bar() called with Str : $str";
}
multi method bar(Int $int) {
return "Foo.bar() called with Int : $int";
}
multi method bar(Numeric $num) {
return "Foo.bar() called with Numeric : $num";
}
multi method baz($f) {
return "Foo.baz() called with parm : $f";
}
}
my $foo = Foo.new();
is($foo.bar(), 'Foo.bar() called with no args', '... multi-method dispatched on no args');
is($foo.bar("Hello"), 'Foo.bar() called with Str : Hello', '... multi-method dispatched on Str');
is($foo.bar(5), 'Foo.bar() called with Int : 5', '... multi-method dispatched on Int');
is($foo.bar(4.2), 'Foo.bar() called with Numeric : 4.2', '... multi-method dispatched on Numeric');
#?rakudo todo 'RT 66006'
try { eval '$foo.baz()' };
#?niecza todo 'This test is pretty dubious IMO'
ok ~$! ~~ /:i argument[s?]/, 'Call with wrong number of args should complain about args';
role R1 {
method foo($x) { 1 } #OK not used
}
role R2 {
method foo($x, $y) { 2 } #OK not used
}
eval_dies_ok 'class X does R1 does R2 { }', 'sanity: get composition conflict error';
class C does R1 does R2 {
proto method foo(|) { * }
}
my $obj = C.new;
#?rakudo 2 skip 'proto does not promote to multi'
#?niecza skip 'No candidates for dispatch to C.foo'
is($obj.foo('a'), 1, 'method composed into multi from role called');
#?niecza skip 'No candidates for dispatch to C.foo'
is($obj.foo('a','b'), 2, 'method composed into multi from role called');
class Foo2 {
multi method a($d) { #OK not used
"Any-method in Foo";
}
}
class Bar is Foo2 {
multi method a(Int $d) { #OK not used
"Int-method in Bar";
}
}
is Bar.new.a("not an Int"), 'Any-method in Foo';
# RT #67024
{
try { eval 'class RT67024 { method a(){0}; method a($x){1} }' };
#?niecza skip 'Exception NYI'
ok $! ~~ Exception, 'redefinition of non-multi method (RT 67024)';
#?niecza todo 'depends on previous test'
ok "$!" ~~ /multi/, 'error message mentions multi-ness';
}
# RT 69192
#?rakudo skip 'unknown bug'
#?niecza skip 'NYI dottyop form .*'
{
role R5 {
multi method rt69192() { push @.order, 'empty' }
multi method rt69192(Str $a) { push @.order, 'Str' } #OK not used
}
role R6 {
multi method rt69192(Numeric $a) { push @.order, 'Numeric' } #OK not used
}
class RT69192 { has @.order }
{
my RT69192 $bot .= new();
($bot does R5) does R6;
$bot.*rt69192;
is $bot.order, <empty>, 'multi method called once on empty signature';
}
{
my RT69192 $bot .= new();
($bot does R5) does R6;
$bot.*rt69192('RT #69192');
is $bot.order, <Str>, 'multi method called once on Str signature';
}
{
my RT69192 $bot .= new();
($bot does R5) does R6;
$bot.*rt69192( 69192 );
is $bot.order, <Numeric>, 'multi method called once on Numeric signature';
}
}
#?niecza skip 'ambiguous'
{
role RoleS {
multi method d( Str $x ) { 'string' } #OK not used
}
role RoleI {
multi method d( Int $x ) { 'integer' } #OK not used
}
class M does RoleS does RoleI {
multi method d( Any $x ) { 'any' } #OK not used
}
my M $m .= new;
is $m.d( 876 ), 'integer', 'dispatch to one role';
is $m.d( '7' ), 'string', 'dispatch to other role';
is $m.d( 1.2 ), 'any', 'dispatch to the class with the roles';
my @multi_method = $m.^methods.grep({ ~$_ eq 'd' });
is @multi_method.elems, 1, '.^methods returns one element for a multi';
my $routine = @multi_method[0];
ok $routine ~~ Routine, 'multi method from ^methods is a Routine';
my @candies = $routine.candidates;
is @candies.elems, 3, 'got three candidates for multi method';
ok @candies[0] ~~ Method, 'candidate 0 is a method';
ok @candies[1] ~~ Method, 'candidate 1 is a method';
ok @candies[2] ~~ Method, 'candidate 2 is a method';
}
{
class BrokenTie {
multi method has_tie(Int $x) { 'tie1' }; #OK not used
multi method has_tie(Int $y) { 'tie2' }; #OK not used
}
dies_ok { BrokenTie.has_tie( 42 ) }, 'call to tied method dies';
class WorkingTie is BrokenTie {
multi method has_tie(Int $z) { 'tie3' }; #OK not used
multi method has_tie(Str $s) { 'tie4' }; #OK not used
}
is WorkingTie.has_tie( 42 ), 'tie3', 'broken class fixed by subclass (1)';
is WorkingTie.has_tie( 'x' ), 'tie4', 'broken class fixed by subclass (2)';
my $error;
try {
WorkingTie.new.has_tie([]);
}
$error = "$!";
ok $error ~~ /<< 'has_tie' >>/,
'error message for failed dispatch contains method name';
ok $error ~~ /<< 'WorkingTie' >>/,
'error message for failed dispatch contains invocant type';
}
# RT #68996
{
class A {
has $.foo = "bar";
multi method foo(Str $test) {
return $test;
}
};
my $a = A.new;
is $a.foo("oh hai"), "oh hai",
'foo() method works when $.foo attribute is present';
dies_ok { $a.foo },
'$.foo attribute has no accessor when foo() method is present';
}
# RT #57788
{
eval_dies_ok 'class RT57788 { method m() { }; method m() { } }';
}
{
class B {
multi method foo() { }
multi method bar() { }
}
lives_ok { B.new.foo() },
'multis with different names but same signatures are not ambiguous';
}
done;
# vim: ft=perl6