Skip to content

Commit df43b77

Browse files
committed
t/class/role.t: Tests for role feature along side new class feature
This is the initial version of the tests created, based off the Corinna spec and against Object::Pad. Since this is the initial version, it might not be completely correct, I'll review it again after I've stepped away and re-read the specs for things to make sure that it looks sane.
1 parent 29e2ba2 commit df43b77

File tree

1 file changed

+161
-0
lines changed

1 file changed

+161
-0
lines changed

t/class/role.t

Lines changed: 161 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,161 @@
1+
#!./perl
2+
3+
BEGIN {
4+
chdir 't' if -d 't';
5+
require './test.pl';
6+
set_up_inc('../lib');
7+
require Config;
8+
}
9+
10+
use v5.36;
11+
use feature 'class';
12+
no warnings 'experimental::class';
13+
14+
{
15+
role Test1Role { # simple empty role
16+
}
17+
18+
class Test1 :does(Test1Role) {
19+
method hello { return "hello, world"; }
20+
21+
method classname { return __CLASS__; }
22+
}
23+
24+
my $obj = Test1->new;
25+
isa_ok($obj, "Test1", '$obj');
26+
27+
is($obj->hello, "hello, world", '$obj->hello');
28+
29+
is($obj->classname, "Test1", '$obj->classname yields __CLASS__');
30+
}
31+
32+
# Roles can provide methods
33+
{
34+
role Test2Role {
35+
method hello { return "hello, world"; }
36+
method classname :common { return __CLASS__; }
37+
}
38+
39+
class Test2 :does(Test2Role) {
40+
}
41+
42+
my $obj = Test2->new;
43+
isa_ok($obj, "Test2", '$obj');
44+
45+
is($obj->hello, "hello, world", '$obj->hello');
46+
47+
# TODO This one is seemingly working based on what I see with Object::Pad but because it's not the core class feature it's not producing the result I expect. discuss, -rv
48+
is(Test2->classname, "Test2", 'Test2->classname yields __CLASS__');
49+
}
50+
51+
# Roles can require methods
52+
{
53+
role Test3Role {
54+
method hello;
55+
}
56+
57+
class Test3a :does(Test3Role) {
58+
method hello { return "hello, world"; }
59+
}
60+
61+
my $obj = Test3a->new;
62+
isa_ok($obj, "Test3a", '$obj');
63+
64+
is($obj->hello, "hello, world", '$obj->hello');
65+
66+
my $result = eval q{
67+
class Test3b :does(Test3Role) {
68+
}; 42
69+
};
70+
71+
my $error = $@;
72+
73+
isnt($result, 42, "Class without required method succceeds");
74+
# TBD fully proper error message, for now copied from how Object::Pad produces it
75+
is($error, "Class Test3b does not provide a required method named 'hello' at (eval 14) line 3.\n", "Correct error message when class is missing required method");
76+
}
77+
78+
79+
# Roles can have fields
80+
{
81+
role Test4Role {
82+
field $world;
83+
field $default = "default value";
84+
85+
method hello { return $default; }
86+
}
87+
88+
role Test4RoleB {
89+
field $world :param;
90+
91+
method hello { return $world; }
92+
}
93+
94+
class Test4 :does(Test4Role) {
95+
}
96+
97+
class Test4B :does(Test4RoleB) {
98+
}
99+
100+
my $obj = Test4->new;
101+
isa_ok($obj, "Test4", '$obj');
102+
103+
is($obj->hello, "default value", '$obj->hello');
104+
105+
my $obj = Test4B->new(world => "HELLO!");
106+
isa_ok($obj, "Test4B", '$obj');
107+
108+
is($obj->hello, "HELLO!", '$obj->hello');
109+
}
110+
111+
# Multiple roles can be consumed
112+
{
113+
role Test5RoleA {
114+
field $A;
115+
116+
method hello { return "hello world!" }
117+
}
118+
119+
role Test5RoleB {
120+
field $world :param;
121+
122+
method methodB { return $world; }
123+
}
124+
125+
class Test5 :does(Test5RoleA) :does(Test5RoleB) {
126+
}
127+
128+
my $obj = Test5->new(world => "the answer is 42");
129+
isa_ok($obj, "Test5", '$obj');
130+
131+
is($obj->hello, "hello world!", '$obj->hello');
132+
133+
is($obj->methodB, "the answer is 42", '$obj->methodB');
134+
}
135+
136+
# Multiple roles can consume roles
137+
{
138+
role Test6RoleA {
139+
field $A;
140+
141+
method hello { return "hello world!" }
142+
}
143+
144+
role Test6RoleB :does(Test6RoleA) {
145+
field $world :param;
146+
147+
method methodB { return $world; }
148+
}
149+
150+
class Test6 :does(Test6RoleB) {
151+
}
152+
153+
my $obj = Test6->new(world => "the answer is 42");
154+
isa_ok($obj, "Test6", '$obj');
155+
156+
is($obj->hello, "hello world!", '$obj->hello');
157+
158+
is($obj->methodB, "the answer is 42", '$obj->methodB');
159+
}
160+
161+
done_testing;

0 commit comments

Comments
 (0)