-
Notifications
You must be signed in to change notification settings - Fork 135
/
calling_sets.t
161 lines (125 loc) · 4.39 KB
/
calling_sets.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
use v6;
use Test;
plan 38;
# L<S12/"Calling sets of methods">
# Some basic tests with only single-dispatch in operation.
class A {
has $.cnt is rw;
method foo { $.cnt += 4 }
}
class B is A {
method foo { $.cnt += 2 }
}
class C is B {
method foo { $.cnt += 1 }
}
{
my $c = C.new();
$c.cnt = 0;
$c.?foo();
is $c.cnt, 1, '.? calls first matching method';
$c.cnt = 0;
$c.*foo();
is $c.cnt, 7, '.* calls up inheritance hierarchy';
$c.cnt = 0;
$c.+foo();
is $c.cnt, 7, '.+ calls up inheritance hierarchy';
is $c.?bar(), Nil, '.? on undefined method gives Nil';
my $lived = 0;
try { $c.+bar(); $lived = 1; }
is $lived, 0, '.+ on undefined method is an error';
is-deeply $c.*bar(), (), '.* on undefined method gives Nil';
my $foo = "foo";
$c.cnt = 0;
$c.?"$foo"();
is $c.cnt, 1, '.? with dynamic method name';
$c.cnt = 0;
$c.*"$foo"();
is $c.cnt, 7, '.* with dynamic method name';
$c.cnt = 0;
$c.+"$foo"();
is $c.cnt, 7, '.+ with dynamic method name';
dies-ok { $c."?foo"() }, '? at start of dynamic name does not imply .?';
dies-ok { $c."+foo"() }, '+ at start of dynamic name does not imply .+';
dies-ok { $c."*foo"() }, '* at start of dynamic name does not imply .*';
}
# Some tests involiving .?, .+ and .* with multi-methods. Since .+ and
# .* are only about single dispatch, then we end up calling the proto
# available at each inheritance level.
class D {
multi method foo() { 'd' }
multi method foo(Int $x) { 'dInt' } #OK not used
multi method foo($x) { 'dAny' } #OK not used
}
class E is D {
multi method foo() { 'e' }
multi method foo(Int $x) { 'eInt' } #OK not used
multi method foo($x, $y, $z) { 'eAnyAnyAny' } #OK not used
}
# RT #119193
{
my $e = E.new();
is $e.foo(), 'e', 'dispatch to one sanity test';
is $e.foo(2.5), 'dAny', 'dispatch to one inherited sanity test';
dies-ok { $e.foo('omg', 'fail') }, 'dispatch to one with no matching multi (sanity test)';
is $e.?foo(), 'e', '.? gets same result as . if there is a multi (match)';
is $e.?foo(2.5), 'dAny', '.? gets same result as . if there is a multi (inherited)';
dies-ok { is $e.?foo('omg', 'fail') }, '.? gets same result as . if there is a multi (no match)';
is $e.*foo(), <e d>, '.* calls multis up inheritance hierarchy';
is $e.*foo(2.5), <dAny dAny>, '.* behaves as single dispatch at each step';
dies-ok { $e.*foo(1, 2, 3) }, '.* dies if there is no matching multi in a base class';
is $e.*foo(), <e d>, '.* calls multis up inheritance hierarchy';
is $e.*foo(2.5), <dAny dAny>, '.* behaves as single dispatch at each step';
dies-ok { $e.*foo(Mu) }, '.* dies if there is no matching multi in subclass';
dies-ok { $e.*foo(1, 2, 3) }, '.* dies if there is no matching multi in a base class';
is $e.+foo(), <e d>, '.* calls multis up inheritance hierarchy';
is $e.+foo(2.5), <dAny dAny>, '.* behaves as single dispatch at each step';
dies-ok { $e.+foo(Mu) }, '.* dies if there is no matching multi in subclass';
dies-ok { $e.+foo(1, 2, 3) }, '.* dies if there is no matching multi in a base class';
}
# Some tests to make sure we walk methods from roles too.
role R1 {
multi method mm { $.cnt += 1 }
multi method sm { $.cnt += 2 }
}
role R2 {
multi method mm { $.cnt += 3 }
}
class F does R1 {
has $.cnt is rw;
}
class G is F does R2 {
}
{
my $g = G.new();
$g.cnt = 0;
$g.?sm();
is $g.cnt, 2, 'single dispatch method from role found with .?';
$g.cnt = 0;
$g.+sm();
is $g.cnt, 2, 'single dispatch method from role found with .+';
$g.cnt = 0;
$g.*sm();
is $g.cnt, 2, 'single dispatch method from role found with .*';
$g.cnt = 0;
$g.?mm();
is $g.cnt, 3, 'multi dispatch method from role found with .?';
$g.cnt = 0;
$g.+mm();
is $g.cnt, 4, 'multi dispatch method from role found with .+';
$g.cnt = 0;
$g.*mm();
is $g.cnt, 4, 'multi dispatch method from role found with .*';
}
class MMT1 {
multi method foo($x) { 42 } #OK not used
}
class MMT2 is MMT1 {
multi method foo(Int $x) { "oh noes" } #OK not used
}
is MMT2.new.?foo("lol"), 42, '.? when initial multi does not match will find next one up';
{
isa-ok MMT1.new.?nonexistent(), Nil, '.?nonexisent() returns Nil';
}
throws-like '1.*WHAT', Exception, '.WHAT is a macro and cannoted be .*ed';
# vim: ft=perl6