Skip to content

Instantly share code, notes, and snippets.

@skids
Last active May 23, 2018 18:45
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save skids/18fa6fb1de776400abd43b6e82e9fcc2 to your computer and use it in GitHub Desktop.
Save skids/18fa6fb1de776400abd43b6e82e9fcc2 to your computer and use it in GitHub Desktop.
rakudo rolevolution branch
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
Copy link
Author

skids commented Mar 21, 2017

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
Copy link
Author

skids commented Mar 21, 2017

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");

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment