Permalink
Fetching contributors…
Cannot retrieve contributors at this time
203 lines (171 sloc) 6.01 KB
use v6;
use Test;
plan 51;
=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';
throws-like q{ $baz ~~ Baz }, X::Undeclared::Symbols, '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';
throws-like '0 but RT66178', X::Undeclared::Symbols, '"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
{
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';
}
{
my role R:ver<0.1>:auth<ority> {}
is R.^ver, v0.1, '.^ver on role works';
is R.^auth, 'ority', '.^auth on role works';
}
# vim: ft=perl6