-
Notifications
You must be signed in to change notification settings - Fork 135
/
typecasting-long.t
124 lines (103 loc) · 4.62 KB
/
typecasting-long.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
use v6;
use Test;
plan 32;
# L<S13/"Type Casting"/"method CALL-ME(**@slice) {...}">
# basic tests to see if the methods overload correctly.
{
my multi testsub ($a,$b) { #OK not used
return 1;
}
my multi testsub ($a) { #OK not used
return 2;
}
my multi testsub () {
return 3;
}
class TypeCastSub {
method CALL-ME (|c) {return 'pretending to be a sub ' ~ testsub(|c) }
}
my $thing = TypeCastSub.new;
is($thing(), 'pretending to be a sub 3', 'overloaded () call works');
is($thing.(), 'pretending to be a sub 3', 'overloaded .() call works');
is($thing.(1), 'pretending to be a sub 2', 'overloaded .($) call works');
is($thing.(1,2), 'pretending to be a sub 1', 'overloaded .($,$) call works');
class TypeCastSub2 {
method CALL-ME (|c) {return 'pretending to be a sub ' ~ testsub(|c) }
}
my $thing2 = TypeCastSub2.new;
is($thing2(), 'pretending to be a sub 3', 'overloaded () call works (CALL-ME)');
is($thing2.(), 'pretending to be a sub 3', 'overloaded .() call works (CALL-ME)');
is($thing2.(1), 'pretending to be a sub 2', 'overloaded .($) call works (CALL-ME)');
is($thing2.(1,2), 'pretending to be a sub 1', 'overloaded .($,$) call works (CALL-ME)');
class TypeCastSub3 {
multi method CALL-ME () {return 'pretending to be a sub 3' }
multi method CALL-ME ($a) {return "pretending to be a sub $a" }
multi method CALL-ME ($a, $b) {return "pretending to be a sub $a $b" }
}
my $thing3 = TypeCastSub3.new;
is($thing3(), 'pretending to be a sub 3', 'overloaded () call works (multi CALL-ME)');
is($thing3.(), 'pretending to be a sub 3', 'overloaded .() call works (multi CALL-ME)');
is($thing3.(2), 'pretending to be a sub 2', 'overloaded .($) call works (multi CALL-ME)');
is($thing3.(3,4), 'pretending to be a sub 3 4', 'overloaded .($,$) call works (multi CALL-ME)');
class TypeCastSub4 {
method CALL-ME () {return "pretending to be a sub" }
}
my $thing4 = TypeCastSub4.new;
is($thing4(), 'pretending to be a sub', 'overloaded () call works (only CALL-ME)');
is($thing4.(), 'pretending to be a sub', 'overloaded .() call works (only CALL-ME)');
class TypeCastSub5 {
method CALL-ME ($a) {return "pretending to be a sub $a" }
}
my $thing5 = TypeCastSub5.new;
is($thing5(42), 'pretending to be a sub 42', 'overloaded ($) call works (only CALL-ME)');
is($thing5.(42), 'pretending to be a sub 42', 'overloaded .($) call works (only CALL-ME)');
class TypeCastSub6 {
method CALL-ME ($a,$b) {return "pretending to be a sub $a $b" }
}
my $thing6 = TypeCastSub6.new;
is($thing6(42,43), 'pretending to be a sub 42 43', 'overloaded ($,$) call works (only CALL-ME)');
is($thing6.(42,43), 'pretending to be a sub 42 43', 'overloaded .($,$) call works (only CALL-ME)');
}
# RT #114026
{
my $*res = 0;
sub somesub () { $*res = 42; };
class Foo {
has @.a is rw;
method add(&c){ @.a.push(&c) }
method CALL-ME($self: |c) {
@.a>>.(|c)
}
}
my $foo = Foo.new;
$foo.add(&somesub);
$foo();
is $*res, 42, 'example code from RT #114026 works';
}
# RT #112642
{
class A { method CALL-ME (A:U:) { 3 } };
is A.(), 3, 'RT #112642 .() -> (:U) works, dotted form';
is A(:a), 3, 'RT #112642 (:a) -> (:U) works';
is A.(:a), 3, 'RT #112642 .(:a) -> (:U) works, dotted form';
class B { method CALL-ME(B:U: $x) { 3 } };
is B(0), 3, 'RT #112642 ($: $) -> (:U, $) case';
is B.(0), 3, 'RT #112642 .($: $) -> (:U, $) case, dotted form';
throws-like 'class XYX { method CALL-ME(XYX:U: $x) { } }; XYX(:a);', Exception, 'RT #112642 ($:, :$) -> (:U, $) arity check';
throws-like 'class XYY { method CALL-ME(XYY:U: $x) { } }; XYY.();', Exception, 'RT #112642 .($:) -> (:U, $) arity check';
throws-like 'class YYY { method CALL-ME(YYY:U: $x) { } }; YYY.(:a);', Exception, 'RT #112642 .($:, :$) -> (:U, $) arity check';
throws-like 'class XYZ { method CALL-ME(XYZ:U: $x) { } }; XYZ(3,4,5);', Exception, 'RT #112642 ($: $, $, $) -> (:U, $) arity check';
throws-like 'class XZZ { method CALL-ME(XZZ:U: $x) { } }; XZZ.(3,4,5);', Exception, 'RT #112642 .($: $, $, $) -> (:U, $) arity check';
isa-ok A().HOW, Metamodel::CoercionHOW, 'A() is a type coercion literal';
isa-ok A(Any).HOW, Metamodel::CoercionHOW, 'A(Any) is a type coercion literal';
}
# RT #115850
{
class Bar {
has $.str;
method CALL-ME($i, $k) { $.str.substr: $i, $k }
}
my Bar $x .= new: :str("abcde");
is $x(2, 1), 'c', 'example from RT #115850 works';
}
# vim: ft=perl6