-
Notifications
You must be signed in to change notification settings - Fork 135
/
basic.t
197 lines (167 loc) · 5.87 KB
/
basic.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
use v6;
use Test;
plan 49;
=begin description
Basic role tests from L<S14/Roles>
=end description
# L<S14/Roles>
# Basic definition
role Foo {}
class Bar does Foo {};
# Smartmatch and .HOW.does and .^does
my $bar = Bar.new();
ok ($bar ~~ Bar), '... smartmatch our $bar to the Bar class';
ok ($bar.HOW.does($bar, Foo)), '.HOW.does said our $bar does Foo';
ok ($bar.^does(Foo)), '.^does said our $bar does Foo';
ok ($bar ~~ Foo), 'smartmatch said our $bar does Foo';
nok Foo.defined, 'role type objects are undefined';
# Can also write does inside the class.
{
role Foo2 { method x { 42 } }
class Bar2 { also does Foo2; }
my $bar2 = Bar2.new();
ok ($bar2 ~~ Foo2), 'smartmatch works when role is done inside class';
is $bar2.x, 42, 'method composed when role is done inside class';
}
# Mixing a Role into a Mu using imperative C<does>
my $baz = { };
ok defined($baz does Foo), 'mixing in our Foo role into $baz worked';
ok $baz.HOW.does($baz, Foo), '.HOW.does said our $baz now does Foo';
ok $baz.^does(Foo), '.^does said our $baz now does Foo';
eval-dies-ok q{ $baz ~~ Baz }, 'smartmatch against non-existent type dies';
# L<S14/Roles/but with a role keyword:>
# Roles may have methods
{
role A { method say_hello(Str $to) { "Hello, $to" } }
my Bar $a .= new();
ok(defined($a does A), 'mixing A into $a worked');
is $a.say_hello("Ingo"), "Hello, Ingo",
'$a "inherited" the .say_hello method of A';
}
# L<S14/Roles/Roles may have attributes:>
{
role B { has $.attr is rw = 42 }
my Bar $b .= new();
$b does B;
ok defined($b), 'mixing B into $b worked';
is $b.attr, 42, '$b "inherited" the $.attr attribute of B (1)';
is ($b.attr = 23), 23, '$b "inherited" the $.attr attribute of B (2)';
# L<S14/Run-time Mixins/"but creates a copy">
# As usual, ok instead of todo_ok to avoid unexpected succeedings.
my Bar $c .= new(),
ok defined($c), 'creating a Foo worked';
ok !($c ~~ B), '$c does not B';
ok (my $d = $c but B), 'mixing in a Role via but worked';
ok !($c ~~ B), '$c still does not B...';
ok $d ~~ B, '...but $d does B';
}
# Using roles as type constraints.
role C { }
class DoesC does C { }
lives-ok { my C $x; }, 'can use role as a type constraint on a variable';
dies-ok { my C $x = 42 }, 'type-check enforced';
dies-ok { my C $x; $x = 42 }, 'type-check enforced in future assignments too';
lives-ok {my C $x = DoesC.new },'type-check passes for class doing role';
lives-ok { my C $x = 42 but C },'type-check passes when role mixed in';
class HasC {
has C $.x is rw;
}
lives-ok { HasC.new }, 'attributes typed as roles initialized OK';
lives-ok { HasC.new.x = DoesC.new },
'typed attribute accepts things it should';
dies-ok { HasC.new.x = Mu }, 'typed attribute rejects things it should';
dies-ok { HasC.new.x = 42 }, 'typed attribute rejects things it should';
eval-dies-ok '0 but RT66178', '"but" with non-existent role dies';
{
dies-ok { EVAL 'class Animal does NonExistentRole { }; 1' },
'a class dies when it does a non-existent role';
try { EVAL 'class AnotherAnimal does NonExistentRole { }; 1' };
my $err = "$!";
ok $err ~~ /NonExistentRole/,
'... and the error message mentions the role';
}
# RT #67278
{
class AClass { };
dies-ok { EVAL 'class BClass does AClass { }; 1' },
'class SomeClass does AnotherClass dies';
my $x = try EVAL 'class CClass does AClass { }; 1';
ok "$!" ~~ /AClass/, 'Error message mentions the offending non-role';
}
# RT #72840
{
try EVAL 'class Boo does Boo { };';
ok "$!" ~~ /Boo/, 'class does itself produces sensible error message';
}
# RT #120646
throws-like 'role RR { }; class RR { };', X::Redeclaration, symbol => 'RR';
throws-like 'role RRR { }; class RRR does RRR { };', X::Redeclaration,
symbol => 'RRR';
# RT #69170
{
role StrTest {
method s { self.gist }
};
ok StrTest.s ~~ /StrTest/,
'default role gistification contains role name';
}
# RT #72848
lives-ok {0 but True}, '0 but True has applicable candidate';
# RT #67768
#?rakudo skip 'RT #67768'
{
eval-lives-ok 'role List { method foo { 67768 } }',
'can declare a role with a name already assigned to a class';
eval-lives-ok 'class C67768 does OUR::List { }',
'can use a role with a name already assigned to a class';
is ::OUR::C67768.new.foo, 67768,
'can call method from a role with a name already assigned to a class';
}
# RT #114380
{
lives-ok { my role R { my $.r }; my class C does R {} },
'Can have "my $.r" in a role (RT #114380)';
}
# RT #116226
#?niecza skip "Unable to resolve method x in type AccessesAttr"
{
my role AccessesAttr {
method meth() {
self.x;
}
}
my class WithAttr does AccessesAttr {
has $.x = 42;
method meth() {
self.AccessesAttr::meth();
}
}
is WithAttr.new.meth, 42, '$obj.Role::method() passes correct invocant';
}
# RT #120919
#?rakudo.jvm skip 'RT #120919'
{
my role A {
method pub { self!priv };
method !priv () { 42 };
};
my class C does A { };
is C.new.pub, 42, 'private methods in roles bind "self" correctly';
}
# RT 120931
{
lives-ok { role RT120931 { method foo {}; RT120931.foo } },
'can call a role method from within the role block';
}
# RT #117041
{
throws-like { EVAL q[role A::B { method foo(A::C $a) { } }] },
X::Parameter::InvalidType,
'undeclared type in signature in role results in X::Parameter::InvalidType';
}
# RT #123002
{
lives-ok { sub rt123002 { EVAL 'role RT123002 { }' }; rt123002 },
'can call a sub which runs EVAL on minimal role declaration';
}
# vim: ft=perl6