skids/rolevolution.txt

skids · 2017-03-21T04:55:32Z

use Test;
use Test::Util;

my $code;

$code = q[
insist role A { method a { 42 } };
role B does A { method a { 43 } };
class C does B { };
C.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\"] }, "simple insist on role");

$code = q[
role A { insist method a { 42 } };
role B does A { method a { 43 } };
class C does B { };
C.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\"] }, "insist on single method");

$code = q[
insist role A { insist method a { 42 } };
role B does A { method a { 43 } };
class C does B { };
C.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\"] }, "insist on both does nothing odd");

$code = q[
role A { insist method a { 42 } };
class C does A { };
C.a.print;
];
is_run($code, { out => 42, err => '' }, "insist on class-composed method");

$code = q[
insist role A { method a { 42 } };
class C does A { };
C.a.print;
];
is_run($code, { out => 42, err => '' }, "insist on class-composed role");

$code = q[
role A { method a { 42 } };
role B does A { insist method a  { 43 } };
class C does B { };
C.a.print;
];
is_run($code, { out => 43, err => '' }, "insist on an overriding role, class-composed");

$code = q[
role A { method a { 42 } };
insist role B does A { method a { 43 } };
class C does B { };
C.a.print;
];
is_run($code, { out => 43, err => '' }, "insist on an overriding method, class-composed");

$code = q[
insist role A { method a { 42 } };
insist role B does A { };
role C does B { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\"] }, "warning finds actual origin role");

$code = q[
role A { method a { 42 } };
insist role B does A { };
role C does B { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => '' }, "insist on role not contagious to cronies");

$code = q[
role A { insist method a { 42 } };
role B does A { };
role C does B { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\"] }, "insist on distant method");

$code = q[
role A { insist method a  { 42 } };
role B { method a { 42.2 } };
role C does B does A { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\"] }, "insist on ambiguous method");

$code = q[
role A { method a { 42 } };
role B { insist method a { 42.2 } };
role C does B does A { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"B\"] }, "insist on other ambiguous method");

$code = q[
role A { insist method a { 42 } };
role B { insist method a { 42.2 } };
role C does B does A { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"B\"] }, "insist on both ambiguous methods");

$code = q[
role A { insist method a { 42 } };
role B { insist method a { 42.2 } };
role C does A does B { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\"] }, "insist on both ambiguous methods (order)");

$code = q[
insist role A { method a  { 42 } };
role B { method a { 42.2 } };
role C does B does A { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\"] }, "insist on ambiguous method (role)");

$code = q[
role A { method a { 42 } };
insist role B { method a { 42.2 } };
role C does B does A { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"B\"] }, "insist on other ambiguous method (role)");

$code = q[
insist role A { method a { 42 } };
insist role B { method a { 42.2 } };
role C does B does A { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"B\"] }, "insist on both ambiguous methods (roles)");

$code = q[
insist role A { method a { 42 } };
insist role B { method a { 42.2 } };
role C does A does B { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\"] }, "insist on both ambiguous method (roles, order)");


$code = q[
insist role A { multi method a($a) { 42 } };
role B does A { multi method a($a) { 43 } };
class C does B { };
C.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"] }, "simple insist on role (multi)");

$code = q[
role A { insist multi method a($a) { 42 } };
role B does A { multi method a($a) { 43 } };
class C does B { };
C.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"] }, "simple insist on multimethod");


$code = q[
role A {
    insist multi method a($a) { 42 }
    multi method a($a, $b) { 44 }
};
role B does A { multi method a($a) { 43 } };
class C does B { };
print C.a(1) ~ C.a(1,2);
];
is_run($code, { out => 4344, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"] }, "insist only affects one multi candidate");

$code = q[
role A { multi method a($a) { 42 } };
role B does A { insist multi method a($a)  { 43 } };
class C does B { };
C.a(1).print;
];
is_run($code, { out => 43, err => '' }, "insist on overriding multimethod does nothing");

$code = q[
role A { multi method a($a) { 42 } };
insist role B does A  { multi method a($a) { 43 } };
class C does B { };
C.a(1).print;
];
is_run($code, { out => 43, err => '' }, "insist on overriding role does nothing (multi)");

$code = q[
role A { insist multi method a($a) { 42 } };
role B does A { insist multi method a($a)  { 43 } };
class C does B { };
C.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"] }, "insist on both multimethods does nothing odd");

$code = q[
insist role A { multi method a($a) { 42 } };
insist role B does A  { multi method a($a) { 43 } };
class C does B { };
C.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"] }, "insist on both roles does nothing odd (multi)");

$code = q[
insist role A { multi method a($a) { 42 } };
role B does A { };
role C does B { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"] }, "insist warning finds actual origin role (multi)");

$code = q[
role A { multi method a($a)  { 42 } };
insist role B does A { };
role C does B { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => ''}, "insist on role is not contagious to cronies (multi)");

$code = q[
role A { insist multi method a($a)  { 42 } };
role B { multi method a($a)  { 42.2 } };
role C does A does B { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"]}, "insist on ambiguous multimethod");

$code = q[
role A  { multi method a($a) { 42 } };
role B  { insist multi method a($a) { 42.2 } };
role C does A does B { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"B\"]}, "insist on other ambiguous multimethod");

$code = q[
role A  { insist multi method a($a) { 42 } };
role B  { insist multi method a($a) { 42.2 } };
role C does A does B { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"]}, "insist on both ambiguous multimethods");

$code = q[
role A  { insist multi method a($a) { 42 } };
role B  { insist multi method a($a) { 42.2 } };
role C does B does A { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"B\"]}, "insist on both ambiguous multimethods (order)");

$code = q[
insist role A { multi method a($a)  { 42 } };
role B { multi method a($a)  { 42.2 } };
role C does A does B { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"]}, "insist on ambiguous multimethod (role)");

$code = q[
role A  { multi method a($a) { 42 } };
insist role B  { multi method a($a) { 42.2 } };
role C does A does B { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"B\"]}, "insist on other ambiguous multimethod (role)");

$code = q[
insist role A  { multi method a($a) { 42 } };
insist role B  { multi method a($a) { 42.2 } };
role C does A does B { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\"]}, "insist on both ambiguous multimethods (role)");

$code = q[
insist role A  { multi method a($a) { 42 } };
insist role B  { multi method a($a) { 42.2 } };
role C does B does A { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"B\"]}, "insist on both ambiguous multimethods (order, role)");

$code = q[
role A  { insist multi method a($a) { 42 } };
class D does A { multi method a($a) { 43 } };
D.a(1).print;
];
is_run($code, { out => 43, err => ''}, "no warning on class override (multi)");

$code = q[
insist role A { method !a { 42 } };
role B does A { method !a { 43 }; method aa { self!a() }};
class C does B { };
C.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\"] }, "simple insist on role, private method");

$code = q[
role A { insist method !a { 42 } };
role B does A { method !a { 43 }; method aa { self!a() }};
class C does B { };
C.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\"] }, "insist on single !method");

$code = q[
insist role A { insist method !a { 42 }; method aa { self!a() }};
role B does A { method !a { 43 } };
class C does B { };
C.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\"] }, "insist on both does nothing odd, private method");

$code = q[
role A { insist method !a { 42 }; method aa { self!a() }};
class C does A { };
C.aa.print;
];
is_run($code, { out => 42, err => '' }, "insist on class-composed !method");

$code = q[
insist role A { method !a { 42 }; method aa { self!a() }};
class C does A { };
C.aa.print;
];
is_run($code, { out => 42, err => '' }, "insist on class-composed role, private method");

$code = q[
role A { method !a { 42 } };
role B does A { insist method !a { 43 }; method aa { self!a() }};
class C does B { };
C.aa.print;
];
is_run($code, { out => 43, err => '' }, "insist on an overriding role, class-composed, private method");

$code = q[
role A { method !a { 42 } };
insist role B does A { method !a { 43 }; method aa { self!a() }};
class C does B { };
C.aa.print;
];
is_run($code, { out => 43, err => '' }, "insist on an overriding !method, class-composed");

$code = q[
insist role A { method !a { 42 } };
insist role B does A { };
role C does B { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\"] }, "warning finds actual origin role, private method");

$code = q[
role A { method !a { 42 } };
insist role B does A { };
role C does B { method !a { 43 } };
class D does C { method aa { self!a() } };
D.aa.print;
];
is_run($code, { out => 43, err => '' }, "insist on role not contagious to cronies, private method");

$code = q[
role A { insist method !a { 42 } };
role B does A { };
role C does B { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\"] }, "insist on distant !method");

$code = q[
role A { insist method !a  { 42 } };
role B { method !a { 42.2 } };
role C does B does A { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\"] }, "insist on ambiguous !method");

$code = q[
role A { method !a { 42 } };
role B { insist method !a { 42.2 } };
role C does B does A { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"B\"] }, "insist on ambiguous !method");

$code = q[
role A { insist method !a { 42 } };
role B { insist method !a { 42.2 } };
role C does B does A { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"B\"] }, "insist on both ambiguous !methods");

$code = q[
role A { insist method !a { 42 } };
role B { insist method !a { 42.2 } };
role C does A does B { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\"] }, "insist on both ambiguous !methods (order)");

$code = q[
insist role A { method !a  { 42 } };
role B { method !a { 42.2 } };
role C does B does A { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\"] }, "insist on ambiguous !method role");

$code = q[
role A { method !a { 42 } };
insist role B { method !a { 42.2 } };
role C does B does A { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"B\"] }, "insist on ambiguous !method role");

$code = q[
insist role A { method !a { 42 } };
insist role B { method !a { 42.2 } };
role C does B does A { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"B\"] }, "insist on both ambiguous !method roles");

$code = q[
insist role A { method !a { 42 } };
insist role B { method !a { 42.2 } };
role C does A does B { method !a { 43 }; method aa { self!a() }};
class D does C { };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\"] }, "insist on both ambiguous !method roles (order)");

$code = q[
insist role A[$a] { method a { 42 } };
insist role B[$a] { method a { 42.2 } };
role C does A[1] does B[1] { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\[Int\]\"]}, "insist on both ambiguous methods (parametric role)");

$code = q[
insist role A[$a] { method a { 42 } };
insist role B[$a] { method a { 42.2 } };
role C does B[1] does A[1] { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"B\[Int\]\"]}, "insist on both ambiguous methods (order, parametric role)");

$code = q[
insist role A[$a]  { multi method a($a) { 42 } };
insist role B[$a]  { multi method a($a) { 42.2 } };
role C does A[1] does B[1] { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\[Int\]\"]}, "insist on both ambiguous multimethods (parametric role)");

$code = q[
insist role A[$a]  { multi method a($a) { 42 } };
insist role B[$a]  { multi method a($a) { 42.2 } };
role C does B[1] does A[1] { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"B\[Int\]\"]}, "insist on both ambiguous multimethods (order, parametric role)");

$code = q[
insist role A[$a] { method !a { 42 } };
insist role B[$a] { method !a { 42.2 } };
role C does A[1] does B[1] { method !a { 43 } };
class D does C { method aa { self!a() } };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\[Int\]\"]}, "insist on both ambiguous !methods (parametric role)");

$code = q[
insist role A[$a] { method !a { 42 } };
insist role B[$a] { method !a { 42.2 } };
role C does B[1] does A[1] { method !a { 43 } };
class D does C { method aa { self!a() } };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"B\[Int\]\"]}, "insist on both ambiguous !methods (order, parametric role)");

$code = q[
insist role A[$a] { method a { 42 } };
role C does A[1] does A["a"] { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\[Int\]\"]}, "insist on both ambiguous methods (between curries)");

$code = q[
insist role A[$a] { method a { 42 } };
role C does A["a"] does A[1] { method a { 43 } };
class D does C { };
D.a.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent method \"a\" from role \"A\[Str\]\"]}, "insist on both ambiguous methods (order, between curries)");

$code = q[
insist role A[$a]  { multi method a($a) { 42 } };
role C does A[1] does A["a"] { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\[Int\]\"]}, "insist on both ambiguous multimethods (between curries)");

$code = q[
insist role A[$a]  { multi method a($a) { 42 } };
role C does A["a"] does A[1] { multi method a($a) { 43 } };
class D does C { };
D.a(1).print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent multimethod candidate \"a\(.*\)\" from role \"A\[Str\]\"]}, "insist on both ambiguous multimethods (order, between curries)");

$code = q[
insist role A[$a] { method !a { 42 } };
role C does A[1] does A["a"] { method !a { 43 } };
class D does C { method aa { self!a() } };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\[Int\]\"]}, "insist on both ambiguous !methods (between curries)");

$code = q[
insist role A[$a] { method !a { 42 } };
role C does A["a"] does A[1] { method !a { 43 } };
class D does C { method aa { self!a() } };
D.aa.print;
];
is_run($code, { out => 43, err => rx:s[Warning\: Overrode insistent private method \"\!a\" from role \"A\[Str\]\"]}, "insist on both ambiguous !methods (order, between curries)");

skids · 2017-03-21T04:56:43Z

use Test;
use Test::Util;

my $code;

$code = q[
role A { method a { 42 } };
role B { method a { 43 } };
class D does A does B { };
D.a.print;
];
is_run($code, { err => rx:s[Method \'a\' must be resolved by class D because it exists in multiple roles \((A\, B|B\, A)\)]}, "direct method collision");

$code = q[
role A { method a { 42 } };
role B { method a { 43 } };
role C1 does A { };
role C2 does B { };
class D does C1 does C2 { };
D.a.print;
];
is_run($code, { err => rx:s[Method \'a\' must be resolved by class D because it exists in multiple roles \((B via C2\, A via C1|A via C1\, B via C2)\)]}, "indirect method collision");

$code = q[
role A { method !a { 42 } };
role B { method !a { 43 } };
class D does A does B { method b { self!a() } };
D.b.print;
];
is_run($code, { err => rx:s[Private method \'a\' must be resolved by class D because it exists in multiple roles \((A\, B|B\, A)\)]}, "direct private method collision");

$code = q[
role A { method !a { 42 } };
role B { method !a { 43 } };
role C1 does A { };
role C2 does B { };
class D does C1 does C2 { method b { self!a() } };
D.a.print;
];
is_run($code, { err => rx:s[Private method \'a\' must be resolved by class D because it exists in multiple roles \((B via C2\, A via C1|A via C1\, B via C2)\)]}, "indirect private method collision");

$code = q[
role A { multi method a { 42 } };
role B { multi method a { 43 } };
class D does A does B { };
D.a.print;
];
is_run($code, { err => rx:s[Multi method \'a\' with signature .* must be resolved by class D because it exists in multiple roles \((A\, B|B\, A)\)]}, "direct multimethod collision");

$code = q[
role A { multi method a { 42 } };
role B { multi method a { 43 } };
role C1 does A { };
role C2 does B { };
class D does C1 does C2 { };
D.a.print;
];
is_run($code, { err => rx:s[Multi method \'a\' with signature .* must be resolved by class D because it exists in multiple roles \((B via C2\, A via C1|A via C1\, B via C2)\)]}, "indirect multimethod collision");

$code = q[
role A[$a] { method a { 42 } };
class D does A[1] does A[2] { };
D.a.print;
];
is_run($code, { err => rx:s[Method \'a\' must be resolved by class D because it exists in multiple roles \(A\[Int\] via A\, A\[Int\] via A\)]}, "direct method collision (between specializations)");

$code = q[
role A[$a] { method a { 42 } };
role C1 does A[1] { };
role C2 does A[2] { };
class D does C1 does C2 { };
D.a.print;
];
is_run($code, { err => rx:s[Method \'a\' must be resolved by class D because it exists in multiple roles \((A\[Int\] via C2\, A\[Int\] via C1|A via C1\, B via C2)\)]}, "indirect method collision (between specializations)");

$code = q[
role A[$a] { method !a { 42 } };
class D does A[1] does A[2] { method b { self!a() } };
D.b.print;
];
is_run($code, { err => rx:s[Private method \'a\' must be resolved by class D because it exists in multiple roles \(A\[Int\] via A\, A\[Int\] via A\)]}, "direct private method collision (between specializations)");

$code = q[
role A[$a] { method !a { 42 } };
role C1 does A[1] { };
role C2 does A[2] { };
class D does C1 does C2 { method b { self!a() } };
D.a.print;
];
is_run($code, { err => rx:s[Private method \'a\' must be resolved by class D because it exists in multiple roles \((A\[Int\] via C2\, A\[Int\] via C1|A via C1\, B via C2)\)]}, "indirect private method collision (between specializations)");

$code = q[
role A[$a] { multi method a { 42 } };
class D does A[1] does A[2] { };
D.a.print;
];
is_run($code, { err => rx:s[Multi method \'a\' with signature .* must be resolved by class D because it exists in multiple roles \(A\[Int\] via A\, A\[Int\] via A\)]}, "direct multimethod collision (between specializations)");

$code = q[
role A[$a] { multi method a { 42 } };
role C1 does A[1] { };
role C2 does A[2] { };
class D does C1 does C2 { };
D.a.print;
];
is_run($code, { err => rx:s[Multi method \'a\' with signature .* must be resolved by class D because it exists in multiple roles \((A\[Int\] via C2\, A\[Int\] via C1|A via C1\, B via C2)\)]}, "indirect multimethod collision (between specializations)");

$code = q[
role A[$b, :$a] { multi method a { 42 } };
role C1 does A[1, :1a] { };
role C2 does A[1, :1a] { };
class D does C1 does C2 { };
D.a.print;
];
#?rakudo todo 'named parameters not part of specialization cache'
is_run($code, { err => '' });

$code = q[
role A { method a { 42 } };
role B does A { };
role C does A { };
class D does B does C { };
D.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond method from roles by class");

$code = q[
role A { method a { 42 } };
role B does A { };
role C does A { };
role D does B does C { };
D.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond method from roles by punned role");

$code = q[
role A { method a { 42 } };
role B does A { };
role C does A { };
role D does B does C { };
class E does D { };
E.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond method from roles by role");

$code = q[
role A[$a] { method a { $a } };
role B does A[42] { };
role C does A[42] { };
class D does B does C { };
D.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond method from specialized roles directly by class");

$code = q[
role A[$a] { method a { $a } };
role B does A[42] { };
role C does A[42] { };
role D does B does C { };
D.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond method from specialized roles by punned role");

$code = q[
role A[$a] { method a { 42 } };
role B does A[42] { };
role C does A[42] { };
role D does B does C { };
class E does D { };
E.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond method from specialized roles by role");

$code = q[
role A { method !a { 42 } };
role B does A { };
role C does A { };
class D does B does C { method b { self!a } };
D.b.print;
];
is_run($code, { out => 42, err => ''}, "diamond private inheritance from roles directly by class");

$code = q[
role A { method !a { 42 } };
role B does A { };
role C does A { };
role D does B does C { method b { self!a } };
D.b.print;
];
is_run($code, { out => 42, err => ''}, "diamond private inheritance from roles by punned role");

$code = q[
role A { method !a { 42 } };
role B does A { };
role C does A { };
role D does B does C { method b { self!a } };
class E does D { };
E.b.print;
];
is_run($code, { out => 42, err => ''}, "diamond private inheritance from roles by role");

$code = q[
role A[$a] { method !a { $a } };
role B does A[42] { };
role C does A[42] { };
class D does B does C { method b { self!a } };
D.b.print;
];
is_run($code, { out => 42, err => ''}, "diamond private inheritance from specialized roles directly by class");

$code = q[
role A[$a] { method !a { $a } };
role B does A[42] { };
role C does A[42] { };
role D does B does C { method b { self!a } };
D.b.print;
];
is_run($code, { out => 42, err => ''}, "diamond private inheritance from specialized roles by punned role");

$code = q[
role A[$a] { method !a { 42 } };
role B does A[42] { };
role C does A[42] { };
role D does B does C { };
class E does D { method b { self!a } };
E.b.print;
];
is_run($code, { out => 42, err => ''}, "diamond private inheritance from specialized roles by role");


$code = q[
role A { multi method a { 42 } };
role B does A { };
role C does A { };
class D does B does C { };
D.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond multi method from roles by class");

$code = q[
role A { multi method a { 42 } };
role B does A { };
role C does A { };
role D does B does C { };
D.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond multi method from roles by punned role");

$code = q[
role A { multi method a { 42 } };
role B does A { };
role C does A { };
role D does B does C { };
class E does D { };
E.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond multi method from roles by role");

$code = q[
role A[$a] { multi method a { $a } };
role B does A[42] { };
role C does A[42] { };
class D does B does C { };
D.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond multi method from specialized roles directly by class");

$code = q[
role A[$a] { multi method a { $a } };
role B does A[42] { };
role C does A[42] { };
role D does B does C { };
D.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond multi method from specialized roles by punned role");

$code = q[
role A[$a] { multi method a { 42 } };
role B does A[42] { };
role C does A[42] { };
role D does B does C { };
class E does D { };
E.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond multi method from specialized roles by role");


$code = q[
role A { has $.a = 42; };
role B does A { };
role C does A { };
class D does B does C { };
D.new.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond attribute from roles by class");

$code = q[
role A { has $.a = 42; };
role B does A { };
role C does A { };
role D does B does C { };
D.new.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond attribute from roles by punned role");

$code = q[
role A { has $.a = 42; };
role B does A { };
role C does A { };
role D does B does C { };
class E does D { };
E.new.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond attribute from roles by role");

$code = q[
role A[$a] { has $.a = 42; };
role B does A[42] { };
role C does A[42] { };
class D does B does C { };
D.new.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond attribute from specialized roles directly by class");

$code = q[
role A[$a] { has $.a = 42; };
role B does A[42] { };
role C does A[42] { };
role D does B does C { };
D.new.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond attribute from specialized roles by punned role");

$code = q[
role A[$a] { has $.a = 42; };
role B does A[42] { };
role C does A[42] { };
role D does B does C { };
class E does D { };
E.new.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond attribute from specialized roles by role");



#$code = q[
#role A { method a { 42 } };
#role B { method a { 43 } };
#class C does B does A { };
#C.a.print;
#];
#is_run($code, { out => 43, err => rx:s[Warning\: Overrode method \"a\" from role \"A\"] }, "method from two different roles collide");


# dubious
$code = q[
role A { method a { 42 } };
role B does A { };
role C does A { };
class D is B is C { };
D.a.print;
];
is_run($code, { out => 42, err => ''}, "diamond method from punned roles causes conflict");

	TLDR:

	https://github.com/skids/rakudo/tree/rolevolution3

	... is a spectest-passing branch of rakudo with:

	A) Working diamond role composition
	B) A solution to Ovid's complaint about role method overrides

	...but the code needs a bit of work.

	======================

	A) DIAMOND ROLE COMPOSITION

	This includes support for allowing roles to be composed in a diamond, so:

	role A { method foo { 42.say } };
	role B does A { };
	role C does A { };
	class D does B does C { };

	...no longer causes role A to conflict wth itself. Private methods,
	identical multi candidates, and attributes also no longer conflict.
	Different specializations of the same parametric roles will conflict,
	as they should, but a specialization will not conflict with itself.
	Note, though, that rakudo's design currently does not cache/consolidate
	specializations that differ by named parameters so while this will
	not cause a conflict:

	role A[$a] { method foo { $a.say } }
	role B does A[1] { };
	role C does A[1] { };
	class D does B does C { };

	...this will:

	role A[$b, :$a] { method foo { $a.say } }
	role B does A[1, :1a] { };
	role C does A[1, :1a] { };
	class D does B does C { };

	I put a fudged test in for that as a todo... or it could be changed
	to a skip depending on what's likely to happen there.

	Error messages were also improved to tell the user the role
	that a method came from, as well as the role that the class
	composed:

	$ perl6 -e 'role A { method f { } }; role B { method f { }}; role C does A { }; role E does B { }; class D does C does E { };'
	===SORRY!=== Error while compiling -e
	Method 'f' must be resolved by class D because it exists in multiple roles (B via E, A via C)

	Guts-wise, in order to accomplish this, I took the liberty of altering
	the '$!package' attribute for Method and Attribute. For attributes
	it is restored after all the role appliers run, as it is used when
	the VM compiles accessors. That could also be restored for methods
	but I'm not sure if it is even used... perhaps some error messages
	may be using it and have changed, so we'll have to see of that change
	is for the better or not.

	Tests for various diamond composition scenarios are appended as a separate file

	==========

	B) NOISY ROLE METHOD OVERRIDES

	Two whole years plus ago Ovid made some observations about Perl6
	roles from a large-project codebase maintainability standpoint.
	The crux of the issue was that, depending on what programming
	culture a project was coming from, they may want to use roles more
	strictly than Perl6 allows. The main stricture needed was
	preventing a role from overriding a method from another role
	which it had composed. (Classes would still be allowed to do so.)

	This conflicts with some of the uses roles are put to in
	common Perl6 practice, which cognomial pointed out.

	Links to the original discussions:
	https://justrakudoit.wordpress.com/2015/03/07/role-inheritance/
	https://github.com/perl6/specs/issues/80

	Ovid's main concern was that refactors or reordering of role
	inclusion should not cause unintended problems. The main
	way this would happen is if a method provided by a role was
	changed with the expectation that all users of that role
	would be changed accordingly. If something overrode that
	method, this would prevent that change from reaching past that
	override.

	In lieu of forbidding the functionality cognomial advocated
	for, Ovid suggested the compiler should spit out some warnings
	when a role overrode a method from another role. This branch
	adds a scope modifier, "insist", which can be used by a role
	author to cause such warnings. The presence of an insist scope
	should serve as a visible warning that the role is strict.

	A solution using a "claim" scope modifier was proposed earlier.
	This differs from that in that "claim" was to be applied at
	the point of override... "insist" is applied on the thing that
	might be overridden, so it is the author of a role that decides
	how it should be usable.

	An "insist" may be applied to individual methods or multi
	candidates, or, it may be applied to an entire role to mark
	all its methods and multimethods as insistent. Once a method
	is insistent, overriding it from a role which composes the method
	causes a warning. Note that classes may still silently override
	the method.

	Yada methods ignore this modifier.

	An "insist" is not contagious, since roles are flatly composed.
	A non-insistent method does not become insistent just because
	the role it "comes from" (from an inheritish viewpoint) is a
	crony of an insistent role.

	A side-effect of the addition of "insist" is to fix this behavior:

	m: role A { multi method aa($a) { 42.say } }; role B { multi method aa($a) { 43.say } }; role C does A does B { multi method aa($a) { 44.say }}; class D does C { }
	camelia: rakudo-moar d232f3: OUTPUT: «===SORRY!=== Error while compiling <tmp>␤Multi method 'aa' with signature :(D $: $a, *%_) must be resolved by»

	... as roles can now disambiguate conflicting multi candidates by
	overriding them (though calling the conflicting candidates from
	within this override seems not to be possible which is still LTA.)
	In this case, to avoid a warning, no conflicting methods may be
	insistent.

	Tests for the 'is face' functionality are appended as a separate file

	CLEANUP/REVIEW needed

	I'm posting this since it is functional but it is not ready for merge.
	There are a number of tacky things that need to be smoothed over.
	For example, my nqp wizardry is not advanced enough to figure
	out how to tell if a variable contained a CurriedRole, without doing
	a iseq_s on the .HOW.name, because of weird behaviors of that particular
	not-quite-really-a-HOW role.

	Also I don't know whether the code in RoleToRoleApplier.nqp is unrolled
	on purpose for performance or whether I should start to factor out some
	subs.

	In some places I may have added an attrib or method in BOOTSTRAP where
	it may be perfectly fine in the .pm class in a hasty act of overkill.

	$!yada and the new $!insist attribute on Method might be better merged
	into a bitflag field.

	A minor alteration of the metaprogramming API alters a method which
	is probably not used by any code external to the core: add_collision
	now takes actual roles, not stringified names, in :@roles and an
	additional :@methods parameter.

	Properly complaining for mixins required exempting GLOBAL from
	being considered the same role as itself when composing. Whether
	there are other magical values that may crop up where we'd
	normally get a concrete role and how to write a test to catch
	them needs some review.

	Note the roast test for RT#124749 also seems to expect that diamond
	role composition works when roles are included using "is". My understanding
	is that that situation would be inheriting from two punned classes,
	and I'm a bit doubtful that this should work without conflicts.

	As it happens, this code does let that slide, though I don't know why.
	Before I dig around to fix that a guru call on that second part of that
	test would be nice.

skids/rolevolution.txt

skids commented Mar 21, 2017 •

edited

Loading

skids commented Mar 21, 2017 •

edited

Loading

skids/rolevolution.txt

skids commented Mar 21, 2017 • edited Loading

skids commented Mar 21, 2017 • edited Loading

skids commented Mar 21, 2017 •

edited

Loading

skids commented Mar 21, 2017 •

edited

Loading