This page was generated at 2010-03-12 17:02:06 GMT.
(syn r30053, pugs-smoke 19912)
[ Index of Synopses ]
Synopsis 14: Roles and Parametric Types [DRAFT]
Larry Wall <larry@wall.org>
Tim Nelson <wayland@wayland.id.au>
Jonathan Worthington <jnthn@jnthn.net>
Created: 24 Feb 2009 (extracted from S12-objects.pod)
Last Modified: 8 Jul 2009
Version: 8
This synopsis discusses roles and parametric types, which were originally discussed in A12.
From t/spec/S14-roles/conflicts.t lines 13–43 (no results): (skip)
| # L<S14/Roles>
|
|
|
| my ($was_in_sentry_shake, $was_in_pet_shake, $was_in_general_shake) = 0, 0, 0;
|
| role Sentry { method shake() { $was_in_sentry_shake++; "A" } }
|
| role Pet { method shake() { $was_in_pet_shake++; "B" } }
|
|
|
| class General does Sentry does Pet {
|
|
|
| method shake(Str $what) {
|
| $was_in_general_shake++;
|
| given $what {
|
| when "sentry" { return self.Sentry::shake() }
|
| when "pet" { return self.Pet::shake() }
|
| }
|
| }
|
| }
|
| lives_ok {Pet.new}, "role and class definition worked";
|
|
|
| my $a;
|
| ok(($a = General.new()), "basic class instantiation works");
|
| is $a.shake("sentry"), "A", "conflict resolution works (1-1)";
|
| is $was_in_general_shake, 1, "conflict resolution works (1-2)";
|
| is $was_in_sentry_shake, 1, "conflict resolution works (1-3)";
|
| # As usual, is instead of todo_is to avoid unexpected suceedings.
|
| is $was_in_pet_shake, 0, "conflict resolution works (1-4)";
|
| is $a.shake("pet"), "B", "conflict resolution works (2-1)";
|
| is $was_in_general_shake, 2, "conflict resolution works (2-2)";
|
| is $was_in_sentry_shake, 1, "conflict resolution works (2-3)";
|
| is $was_in_pet_shake, 1, "conflict resolution works (2-4)";
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
From t/spec/S14-roles/basic.t lines 13–39 (no results): (skip)
| # 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';
|
|
|
| # Can also write does inside the class.
|
| role Foo2 { method x { 42 } }
|
| class Bar2 { 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 = 3;
|
| ok defined($baz does Foo), 'mixing in our Foo role into $baz worked';
|
| #?pugs skip 3 'feature'
|
| 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';
|
|
|
Highlighted:
small|full
From t/spec/S14-roles/anonymous.t lines 9–44 (no results): (skip)
| # L<S14/Roles>
|
| {
|
| my $a = 3;
|
| is $a, 3, "basic sanity";
|
| lives_ok { $a does role { has $.cool = "yeah" }}, "anonymous role mixin";
|
| is $a, 3, "still basic sanity";
|
| is $a.cool, "yeah", "anonymous role gave us an attribute";
|
| }
|
|
|
| # The same, but we story the anonymous role in a variable
|
| {
|
| my $a = 3;
|
| is $a, 3, "basic sanity";
|
| my $role;
|
| lives_ok { $role = role { has $.cool = "yeah" } }, "anonymous role definition";
|
| lives_ok { $a does $role }, "anonymous role variable mixin";
|
| is $a, 3, "still basic sanity";
|
| is $a.cool, "yeah", "anonymous role variable gave us an attribute";
|
| }
|
|
|
| # Guarantee roles are really first-class-entities:
|
| {
|
| sub role_generator(Str $val) {
|
| return role {
|
| has $.cool = $val;
|
| }
|
| }
|
|
|
| my $a = 3;
|
| is $a, 3, "basic sanity";
|
| lives_ok {$a does role_generator("hi")}, "role generating function mixin";
|
| is $a, 3, "still basic sanity";
|
| is $a.cool, "hi", "role generating function gave us an attribute";
|
| }
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
From t/spec/S14-roles/submethods.t lines 11–31 (no results): (skip)
| # L<S14/Roles>
|
| # L<S12/Submethods>
|
|
|
| =end pod
|
|
|
|
|
| role AddBuild
|
| {
|
| has $.did_build = 0;
|
| submethod BUILD ( $self: )
|
| {
|
| $!did_build = 1;
|
| }
|
| }
|
|
|
| class MyClass does AddBuild {}
|
|
|
| my $class = MyClass.new();
|
| ok( $class.did_build, 'Class that does role should do submethods of role' );
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
Classes are primarily in charge of object management, and only secondarily in charge of software reuse. In Perl 6, roles take over the job of managing software reuse. Depending on how you care to look at it, a role is like a partial class, or an interface with default implementation, or a set of generic methods and their associated data, or a class closed at compile time.
Roles may be composed into a class at compile time, in which case you get automatic detection of conflicting methods. A role may also be mixed into a class or object at run time to produce an anonymous derived class with extra capabilities, but in this case conflicting methods are overridden by the new role silently. In either case, a class is necessary for instantiation--a role may not be directly instantiated.
From t/spec/S14-roles/composition.t lines 5–114 (no results): (skip)
| # L<S14/Roles/"Roles may be composed into a class at compile time">
|
|
|
| role rA {
|
| method mA1 {
|
| 'mA1';
|
| }
|
| method mA2 {
|
| 'mA2';
|
| }
|
| };
|
|
|
| role rB {
|
| method mB1 {
|
| 'mB1';
|
| }
|
| method mB2 {
|
| 'mB2';
|
| }
|
| };
|
|
|
| class C1 does rA {
|
| method mC1 {
|
| 'mC1';
|
| }
|
| };
|
|
|
| my $x = C1.new();
|
|
|
| is $x.mC1, 'mC1', 'Can call method of class with mixed in role';
|
| is $x.mA1, 'mA1', 'Call first method from role';
|
| is $x.mA2, 'mA2', 'Call second method from role';
|
|
|
| class C2 does rA does rB {
|
| method mC2 {
|
| 'mC2';
|
| }
|
| }
|
|
|
| my $y = C2.new();
|
|
|
| is $y.mC2, 'mC2', 'Can call method of class with two roles mixed in';
|
| is $y.mA1, 'mA1', 'Can call mixed in method (two roles) 1';
|
| is $y.mA2, 'mA2', 'Can call mixed in method (two roles) 2';
|
| is $y.mB1, 'mB1', 'Can call mixed in method (two roles) 3';
|
| is $y.mB2, 'mB2', 'Can call mixed in method (two roles) 4';
|
|
|
| ok C2 ~~ rA, 'class matches first role';
|
| ok C2 ~~ rB, 'class matches second role';
|
| ok rA !~~ C2, 'first role does not match class';
|
| ok rB !~~ C2, 'second role does not match class';
|
|
|
| role RT64002 does rA does rB {}
|
| #?rakudo 2 todo 'RT #64002'
|
| ok RT64002 ~~ rA, 'role matches first role it does';
|
| ok RT64002 ~~ rB, 'role matches second role it does';
|
| ok rA !~~ RT64002, 'role not matched by first role it does';
|
| ok rB !~~ RT64002, 'role not matched by second role it does';
|
|
|
| {
|
| class D1 does rA {
|
| method mA1 {
|
| 'D1.mA1';
|
| }
|
| }
|
|
|
| my $z = D1.new();
|
|
|
| is $z.mA1, 'D1.mA1', 'Can override method in a role with method in a class';
|
| }
|
|
|
| # diamond composition
|
| {
|
| role DA {
|
| method foo { "OH HAI" };
|
| }
|
| role DB does DA { }
|
| role DC does DA { }
|
| class DD does DB does DC { };
|
| is DD.new.foo, 'OH HAI', 'diamond role composition';
|
| class DE is DB is DC { };
|
| is DE.new.foo, 'OH HAI', 'same with punning and inheritance';
|
| }
|
|
|
| # RT #69919
|
| {
|
| role RT69919 {
|
| my $lex = 'Luthor';
|
| method rt69919 { return $lex }
|
| }
|
| class IL does RT69919 {}
|
|
|
| is IL.new.rt69919, 'Luthor', 'access lexical declared in role from method called via class that does the role';
|
| }
|
|
|
|
|
| # inheritance through role composition - specced in A12
|
| # RT 69254
|
| {
|
| class irA {};
|
| role irB is irA {};
|
| class irC does irB {};
|
| ok irC ~~ irB, 'role composition worked';
|
| ok irC ~~ irA, 'role composition transported inheritance';
|
|
|
| }
|
|
|
|
|
| done_testing;
|
|
|
| # vim: syn=perl6
|
Highlighted:
small|full
A role is declared like a class, but with a role keyword:
From t/spec/S14-roles/basic.t lines 40–50 (no results): (skip)
| # L<S14/Roles/but with a role keyword:>
|
| # Roles may have methods
|
| #?pugs skip "todo"
|
| {
|
| 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';
|
| }
|
|
|
Highlighted:
small|full
role Pet {
method feed ($food) {
$food.open_can;
$food.put_in_bowl;
self.eat($food);
}
}
A role may not inherit from a class, but may be composed of other roles. However, this "crony" composition is not evaluated until class composition time. This means that if two roles bring in the same crony, there's no conflict--it's just as if the class pulled in the crony role itself and the respective roles didn't. A role may never conflict with itself regardless of its method of incorporation. A role that brings in two conflicting crony roles may resolve them as if it were a class. This solution is accepted by the class unless the class supplies its own solution. If two different roles resolve the same crony conflict two different ways, those roles are themselves in conflict and must be resolved by a "more derived" role or the class.
From t/spec/S14-roles/crony.t lines 12–36 (no results): (skip)
| # L<S14/Roles/but may be composed of other roles>
|
|
|
| role InnerRole {
|
| has $.inner_role_var_1 is rw;
|
| has $.inner_role_var_2 is rw;
|
| };
|
|
|
| role OuterRole does InnerRole {
|
| has $.outer_role_var_1 is rw;
|
| has $.outer_role_var_2 is rw;
|
| };
|
|
|
| my $w = OuterRole.new;
|
|
|
| $w.outer_role_var_1 = 2;
|
| $w.outer_role_var_2 = 'red';
|
| is $w.outer_role_var_1, 2 , "integer attribute is set in outer role" ;
|
| is $w.outer_role_var_2, 'red', "string attribute is set in outer role" ;
|
|
|
| $w.inner_role_var_1 = 3;
|
| $w.inner_role_var_2 = 'dog';
|
| is $w.inner_role_var_1, 3 , "integer attribute is set in inner role" ;
|
| is $w.inner_role_var_2,'dog' , "string attribute is set in inner role" ;
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
A role doesn't know its own type until it is composed into a class. Any mention of its main type (such as ::?CLASS) is generic, as is any reference to self or the type of the invocant. You can use a role name as a type, but only for constraints, not for declaring actual objects. (However, if you use a role as if it were a class, an anonymous class is generated that composes the role, which provides a way to force a role to test its crony composition for infelicities.)
If a role merely declares methods without defining them, it degenerates to an interface:
role Pet {
method feed ($food) {...}
method groom () {...}
method scratch (:$where) {...}
}
Note that, while these methods must become available at class composition time, they might be supplied by any of: another role, the class itself, or some superclass. We know the methods that are coming from the other roles or the class, but we don't necessarily know the complete set of methods supplied by our super classes if they are open or rely on wildcard delegation. However, the class composer is allowed to assume that only currently declared superclass methods or non-wildcard methods are going to be available. A stub can always be installed somewhere to "supply" a missing method's declaration.
Roles may have attributes:
From t/spec/S14-roles/basic.t lines 51–60 (no results): (skip)
| # 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';
|
| #?rakudo 2 skip "Method 'defined' not found for invocant of class 'Undef'"
|
| 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)';
|
|
|
Highlighted:
small|full
From t/spec/S14-roles/attributes.t lines 5–49 (no results): (skip)
| # L<S14/Roles/"Roles may have attributes">
|
|
|
| role R1 {
|
| has $!a1;
|
| has $.a2 is rw;
|
| };
|
|
|
| class C1 does R1 {
|
| method set_a1($val) {
|
| $!a1 = $val;
|
| }
|
| method get_a1 {
|
| $!a1
|
| }
|
| };
|
|
|
| my $x = C1.new();
|
|
|
| $x.set_a1('abc');
|
| is $x.get_a1, 'abc', 'Can set and get class-private attr from role';
|
|
|
| $x.a2 = 'xyz';
|
| is $x.a2, 'xyz', 'Public attribute gets accessor/mutator composed';
|
|
|
|
|
| role R2 {
|
| has Int $!a;
|
| }
|
|
|
| eval_dies_ok 'class C3 does R2 { has $!a }', 'Roles with conflicing attributes';
|
| eval_dies_ok 'class C2 does R2 { has Int $!a }', 'Same name, same type will also conflicts';
|
|
|
| role R3 {
|
| has $.x = 42;
|
| }
|
| class C4 does R3 { }
|
| is C4.new.x, 42, 'initializing attributes in a role works';
|
|
|
| role R4 { has @!foo; method bar() { @!foo } }
|
| class C5 does R4 {
|
| has $.baz;
|
| }
|
| is C5.new().bar(), [], 'Composing an attribute into a class that already has one works';
|
|
|
| # vim: syn=perl6
|
Highlighted:
small|full
role Pet {
has $.collar = Collar.new(tag => Tag.new);
method id () { return $.collar.tag }
method lose_collar () { undefine $.collar }
}
Within a role the has declarator always indicates the declaration from the viewpoint of the class. Therefore a private attribute declared using has is private to the class, not to the role. You may wish to declare an attribute that is hidden even from the class; a completely private role attribute (that will exist per instance of the class) may be declared like this:
my $!spleen;
The name of such a private attribute is always considered lexically scoped. If a role declares private lexical items, those items are private to the role due to the nature of lexical scoping. Accessors to such items may be exported to the class, but this is not the default. In particular, a role may say
trusts ::?Class;
to allow self!attr() access to the role's $!attr variables with the class or from other roles composed into the class. Conflicts between private accessors are also caught at composition time, but of course need not consider super classes, since no-one outside the current class (or a trusted class) can call a private accessor at all. (Private accessors are never virtual, and must be package qualified if called from a trusted scope other than our own. That is, it's either self!attr() or $obj!TrustsMe::attr().)
A role may also distinguish a shared method
has method foo ...
method foo ... # same
from a nonshared private method:
my method !foo ...
my method foo ... # same, but &foo is aliased to &!foo
From t/spec/S12-methods/private.t lines 44–82 (no results): (skip)
| # L<S14/Roles/"same, but &foo is aliased to &!foo">
|
|
|
| # method !foo in a role gets composed in as a private method and is callable
|
| # as one. XXX Role Private Methods? my method !foo() { ... } different?
|
|
|
| {
|
| role C {
|
| method !role_shared {
|
| 18;
|
| }
|
| my method !role_private {
|
| 36;
|
| }
|
| }
|
|
|
| class B does C {
|
| method !private {
|
| 24;
|
| }
|
| method public1 {
|
| self!private();
|
| }
|
| method public2 {
|
| self!role_shared();
|
| }
|
| method public3 {
|
| self!role_private();
|
| }
|
| }
|
|
|
| my $b = B.new();
|
|
|
| is $b.public1, 24, '"my method private" can be called as self!private';
|
| is $b.public2, 18, 'can call role shared private methods';
|
| #?rakudo todo 'role private methods - spec?'
|
| dies_ok { $b.public3() }, 'can not call role privaate methods scoped with my';
|
| }
|
|
|
| # vim: syn=perl6
|
Highlighted:
small|full
Generally you'd just use a lexically scoped sub, though.
my sub foo ...
[Conjectural: To put a private sub into the class, say
our sub !foo ...
]
A role can abstract the decision to delegate:
role Pet {
has $groomer handles <bathe groom trim> = hire_groomer();
}
Note that this puts the three methods into the class as well as $groomer. In contrast, "my $!groomer" would only put the three methods; the attribute itself is private to the role.
A role is allowed to declare an additional inheritance for its class when that is considered an implementation detail:
role Pet {
is Friend;
}
A class incorporates a role with the verb "does", like this:
class Dog is Mammal does Pet does Sentry {...}
or equivalently, within the body of the class closure:
class Dog {
is Mammal;
does Pet;
does Sentry;
...
}
There is no ordering dependency among the roles.
A class's explicit method definition hides any role definition of the same name. A role method in turn hides any methods inherited from other classes.
If there are no method name conflicts between roles (or with the class), then each role's methods can be installed in the class. If, however, two roles try to introduce a method of the same name the composition of the class fails. (Two has attributes of the same name, whether public or private, are always a composition fail. Role-private attributes are exempt from this, and from the viewpoint of the composition, don't even exist, except to allocate a slot for each such attribute.)
There are several ways to solve method conflicts. The first is simply to write a class method that overrides the conflicting role methods, perhaps figuring out which role method to call.
Alternately, if the role's methods are declared multi, they can be disambiguated based on their long name. If the roles forget to declare them as multi, you can force a multi on the roles' methods by installing a proto stub in the class being constructed:
proto method shake {...}
(This declaration need not precede the does clause textually, since roles are not actually composed until the end of the class definition, at which point we know which roles are to be composed together in a single logical operation, as well as how the class intends to override the roles.)
The proto method will be called if the multi fails:
proto method shake { warn "They couldn't decide" }
From t/spec/S14-roles/mixin.t lines 5–66 (no results): (skip)
| # L<S14/Run-time Mixins/>
|
|
|
| role R1 { method test { 42 } }
|
| class C1 { }
|
|
|
| my $x = C1.new();
|
| $x does R1;
|
| is $x.test, 42, 'method from a role can be mixed in';
|
| is $x.?test, 42, '.? form of call works on a mixed-in role';
|
| is $x.+test, 42, '.+ form of call works on a mixed-in role';
|
| is $x.*test, 42, '.* form of call works on a mixed-in role';
|
|
|
|
|
| role R2 { method test { 42 } }
|
| class C2 { has $.x }
|
| my $y = C2.new(x => 100);
|
| is $y.x, 100, 'initialization sanity check';
|
| $y does R2;
|
| is $y.test, 42, 'method from role was mixed in';
|
| is $y.x, 100, 'mixing in did not destroy old value';
|
|
|
|
|
| role R3 { has $.answer is rw }
|
| class C3 { has $.x }
|
| $y = C3.new(x => 100);
|
| $y does R3;
|
| $y.answer = 42;
|
| is $y.x, 100, 'mixing in with attributes did not destroy existing ones';
|
| is $y.answer, 42, 'mixed in new attributes';
|
|
|
|
|
| $y = C3.new(x => 100);
|
| $y does (R2, R3);
|
| $y.answer = 13;
|
| is $y.x, 100, 'multi-role mixin preserved existing values';
|
| is $y.answer, 13, 'attribute from multi-role mixing OK';
|
| is $y.test, 42, 'method from other role was OK too';
|
|
|
|
|
| role Answer { has $.answer is rw }
|
| $x = 0;
|
| $x does Answer(42);
|
| is $x.answer, 42, 'role mix-in with initialization value worked';
|
| is $x, 0, 'mixing into Int still makes it function as an Int';
|
|
|
| role A { has $.a is rw }
|
| role B { has $.b is rw }
|
| $x does A(1);
|
| $x does B(2);
|
| is $x.a, 1, 'mixining in two roles one after the other';
|
| is $x.b, 2, 'mixining in two roles one after the other';
|
|
|
| my @array does R1;
|
| is @array.test, 42, 'mixing in a role at the point of declaration works';
|
|
|
| #?rakudo skip 'mixin at the point of declaration is compile time'
|
| {
|
| my $x;
|
| BEGIN { $x = @array.test }
|
| is $x, 42, 'mixing in at point of declaration at compile time';
|
| }
|
|
|
Highlighted:
small|full
Run-time mixins are done with does and but. The does binary operator is a mutator that derives a new anonymous class (if necessary) and binds the object to it:
$fido does Sentry
The does infix operator is non-associative, so this is a syntax error:
$fido does Sentry does Tricks does TailChasing does Scratch;
You can, however, say
$fido does Sentry;
$fido does Tricks;
$fido does TailChasing;
$fido does Scratch;
And since it returns the left side, you can also say:
((($fido does Sentry) does Tricks) does TailChasing) does Scratch;
Unlike the compile-time role composition, each of these layers on a new mixin with a new level of inheritance, creating a new anonymous class for dear old Fido, so that a .chase method from TailChasing hides a .chase method from Sentry.
You can also mixin a precomposed set of roles:
$fido does (Sentry, Tricks, TailChasing, Scratch);
This will level the playing field for collisions among the new set of roles, and guarantees the creation of no more than one more anonymous class. Such a role still can't conflict with itself, but it can hide its previous methods in the parent class, and the calculation of what conflicts is done again for the set of roles being mixed in. If you can't do compile-time composition, we strongly recommend this approach for run-time mixins since it approximates a compile-time composition at least for the new roles involved.
A role applied with does may be parameterized with an initializer in parentheses, but only if the role supplies exactly one attribute to the mixin class:
From t/spec/S14-roles/parameterized-mixin.t lines 18–52 (no results): (skip)
| # L<S14/Run-time Mixins/may be parameterized>
|
| role InitialAttribVal[$val] {
|
| has $.attr = $val;
|
| }
|
|
|
| my $a;
|
| lives_ok {$a does InitialAttribVal[42]},
|
| "imperative does to apply a parametrized role (1)";
|
| is $a.attr, 42,
|
| "attribute was initialized correctly (1)";
|
| ok $a.HOW.does($a, InitialAttribVal),
|
| ".HOW.does gives correct information (1-1)";
|
| ok $a.^does(InitialAttribVal),
|
| ".^does gives correct information (1-1)";
|
| ok $a.HOW.does($a, InitialAttribVal[42]),
|
| ".HOW.does gives correct information (1-2)";
|
| ok $a.^does(InitialAttribVal[42]),
|
| ".^does gives correct information (1-2)";
|
|
|
| my $b;
|
| lives_ok { $b does InitialAttribVal[23] },
|
| "imperative does to apply a parametrized role (2)";
|
| is $b.attr, 23,
|
| "attribute was initialized correctly (2)";
|
| ok $b.HOW.does($b, InitialAttribVal),
|
| ".HOW.does gives correct information (2-1)";
|
| ok $b.^does(InitialAttribVal),
|
| ".^does gives correct information (2-1)";
|
| ok $b.HOW.does($b, InitialAttribVal[23]),
|
| ".HOW.does gives correct information (2-2)";
|
| ok $b.^does(InitialAttribVal[23]),
|
| ".^does gives correct information (2-2)";
|
|
|
|
|
|
|
Highlighted:
small|full
From t/spec/S14-roles/parameterized-basic.t lines 16–157 (no results): (skip)
| # L<S14/Run-time Mixins/may be parameterized>
|
|
|
| # Some basic arity-based selection tests.
|
| role AritySelection {
|
| method x { 1 }
|
| }
|
| role AritySelection[$x] {
|
| method x { 2 }
|
| }
|
| role AritySelection[$x, $y] {
|
| method x { 3 }
|
| }
|
| class AS_1 does AritySelection { }
|
| class AS_2 does AritySelection[1] { }
|
| class AS_3 does AritySelection[1, 2] { }
|
| is(AS_1.new.x, 1, 'arity-based selection of role with no parameters');
|
| is(AS_2.new.x, 2, 'arity-based selection of role with 1 parameter');
|
| is(AS_3.new.x, 3, 'arity-based selection of role with 2 parameters');
|
|
|
| # Make sure Foo[] works as well as Foo.
|
| role AritySelection2[] {
|
| method x { 1 }
|
| }
|
| role AritySelection2[$x] {
|
| method x { 2 }
|
| }
|
| class AS2_1 does AritySelection2 { }
|
| class AS2_2 does AritySelection2[] { }
|
| class AS2_3 does AritySelection2[1] { }
|
| is(AS2_1.new.x, 1, 'Foo[] invoked as Foo');
|
| is(AS2_2.new.x, 1, 'Foo[] invoked as Foo[]');
|
| is(AS2_3.new.x, 2, 'Foo[1] (for sanity)');
|
|
|
| # Some type based choices.
|
| class NarrownessTestA { }
|
| class NarrownessTestB is NarrownessTestA { }
|
| role TypeSelection[Str $x] {
|
| method x { 1 }
|
| }
|
| role TypeSelection[NarrownessTestA $x] {
|
| method x { 2 }
|
| }
|
| role TypeSelection[NarrownessTestB $x] {
|
| method x { 3 }
|
| }
|
| role TypeSelection[::T] {
|
| method x { 4 }
|
| }
|
| class TS_1 does TypeSelection["OH HAI"] { }
|
| class TS_2 does TypeSelection[NarrownessTestB.new] { }
|
| class TS_3 does TypeSelection[NarrownessTestA.new] { }
|
| class TS_4 does TypeSelection[Pair] { }
|
| is(TS_1.new.x, 1, 'type-based selection of role');
|
| is(TS_2.new.x, 3, 'type-based selection of role (narrowness test)');
|
| is(TS_3.new.x, 2, 'type-based selection of role (narrowness test)');
|
| is(TS_4.new.x, 4, 'type-based selection of role (type variable)');
|
|
|
| # Use of parameters within methods.
|
| role MethParams[$x] {
|
| method x { $x }
|
| method y { { "42" ~ $x } }
|
| }
|
| class MP_1 does MethParams[1] { }
|
| class MP_2 does MethParams['BBQ'] { }
|
| is(MP_2.new.x, 'BBQ', 'use of type params in methods works...');
|
| is(MP_1.new.x, 1, '...even over many invocations.');
|
| is(MP_2.new.y, '42BBQ', 'params in nested scopes in methods');
|
| is(MP_1.new.y, '421', 'params in nested scopes in methods');
|
|
|
| # Use of parameters with attribute initialization.
|
| role AttrParams[$a, $b] {
|
| has $.x = $a;
|
| has $.y = $b;
|
| }
|
| class AP_1 does AttrParams['a','b'] { }
|
| class AP_2 does AttrParams[1,2] { }
|
| is(AP_2.new.x, 1, 'use of type params in attr initialization works');
|
| is(AP_2.new.y, 2, 'use of type params in attr initialization works');
|
| is(AP_1.new.x, 'a', 'use of type params in attr initialization works after 2nd invocation');
|
| is(AP_1.new.y, 'b', 'use of type params in attr initialization works after 2nd invocation');
|
|
|
| # Use of parameters as type constraints.
|
| role TypeParams[::T] {
|
| method x(T $x) { return "got a " ~ T ~ " it was $x" }
|
| }
|
| class TTP_1 does TypeParams[Int] { }
|
| class TTP_2 does TypeParams[Str] { }
|
| is(TTP_1.new.x(42), 'got a Int() it was 42', 'type variable in scope and accepts right value');
|
| is(TTP_2.new.x("OH HAI"), 'got a Str() it was OH HAI', 'type variable in scope and accepts right value');
|
| dies_ok({ TTP_1.new.x("OH HAI") }, 'type constraint with parameterized type enforced');
|
| dies_ok({ TTP_2.new.x(42) }, 'type constraint with parameterized type enforced');
|
|
|
| # test multi dispatch on parameterized roles
|
| # not really basic anymore, but I don't know where else to put these tests
|
| #?rakudo skip 'composition time multi dispatch with generics/where-blocks'
|
| {
|
| role MD_block[Int $x where { $x % 2 == 0 }] {
|
| method what { 'even' };
|
| }
|
| role MD_block[Int $x where { $x % 2 == 1 }] {
|
| method what { 'odd' };
|
| }
|
|
|
| class CEven does MD_block[4] { };
|
| class COdd does MD_block[3] { };
|
|
|
| is CEven.new.what, 'even',
|
| 'multi dispatch on parameterized role works with where-blocks (1)';
|
| is COdd.new.what, 'odd',
|
| 'multi dispatch on parameterized role works with where-blocks (2)';
|
| is CEven.what, 'even',
|
| 'same with class methods (1)';
|
| is COdd.what, 'odd',
|
| 'same with class methods (2)';
|
| eval_dies_ok 'class MD_not_Int does MD_block["foo"] { }',
|
| "Can't compose without matching role multi";
|
|
|
| role MD_generics[::T $a, T $b] {
|
| method what { 'same type' }
|
| }
|
| role MD_generics[$a, $b] {
|
| method what { 'different type' }
|
| }
|
| class CSame does MD_generics[[], []] { }
|
| class CDiff does MD_generics[4, {}] { }
|
|
|
| is CSame.new.what, 'same type',
|
| 'MD with generics at class composition time (1)';
|
| is CDiff.new.what, 'different type',
|
| 'MD with generics at class composition time (2)';
|
|
|
| is CSame.what, 'same type',
|
| 'MD with generics at class composition time (class method) (1)';
|
| is CDiff.what, 'different type',
|
| 'MD with generics at class composition time (class method) (2)';
|
| eval_dies_ok 'class WrongFu does MD_generics[3] { }',
|
| 'MD with generics at class composition times fails (wrong arity)';
|
| }
|
|
|
| #?pugs emit =end SKIP
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
From t/spec/S14-roles/mixin.t lines 67–92 (no results): (skip)
| # L<S14/Run-time Mixins/"but only if the role supplies exactly one attribute">
|
|
|
| {
|
| role R4a {
|
| # no attribute here
|
| }
|
| role R4b {
|
| has $.x is rw;
|
| }
|
| role R4c {
|
| has $.x;
|
| has $.y;
|
| }
|
|
|
| dies_ok { my $x = 4; $x does R4a(3) },
|
| '"does role(param)" does not work without attribute';
|
| lives_ok { my $x = 4; $x does R4b(3) },
|
| '"does role(param)" does work with one attribute';
|
| dies_ok { my $x = 4; $x does R4c(3) },
|
| '"does role(param)" does not work with two attributes';
|
| is ([] does R4b("foo")).x, 'foo',
|
| 'can mix R4b into an Array, and access the attribute';
|
| }
|
|
|
|
|
| # vim: syn=perl6
|
Highlighted:
small|full
$fido does Wag($tail);
$line does taint($istainted);
Note that the parenthesized form is not a subroutine or method call. It's just special initializing syntax for roles that contain a single property.
The supplied initializer will be coerced to the type of the attribute. Note that this initializer is in addition to any parametric type supplied in square brackets, which is considered part of the actual type name:
$myobj does Array[Int](@initial)
A property is defined by a role like this:
role answer {
has Int $.answer is rw = 1;
}
The property can then be mixed in or, alternatively, applied using the but operator. but is like does, but creates a copy and mixes into that instead, leaving the original unmodified. Thus:
From t/spec/S14-roles/basic.t lines 61–112 (no results): (skip)
| # 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';
|
| #?rakudo todo 'Cannot assign Mu to variable with role constraint -- bug or feature?'
|
| lives_ok { my C $x = Mu }, 'can assign undefined';
|
| 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';
|
| lives_ok { HasC.new.x = Mu }, 'typed attribute accepts things it should';
|
| #?rakudo todo "Type attribute accepts anything?"
|
| dies_ok { HasC.new.x = 42 }, 'typed attribute rejects things it should';
|
|
|
| # Checking if role does role
|
| role D {
|
| }
|
|
|
| ok D ~~ Role, 'a role does the Role type';
|
|
|
| # If these two tests are swapped, rakudo gives a stack trace on exit.
|
| #?rakudo skip 'class as role (RT #60176)'
|
| {
|
| eval_lives_ok 'class Plain {}; class DoesClass does Plain {}',
|
| 'a class is also a role';
|
|
|
| eval_lives_ok 'class DoesInt does Int {}',
|
| 'can compile "class does Int"';
|
| }
|
|
|
| eval_dies_ok '0 but RT66178', '"but" with non-existent role dies';
|
|
|
| done_testing;
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
$a = 0 but answer(42)
Really means something like:
$a = ($anonymous = 0) does answer(42);
Which really means:
(($anonymous = 0) does answer).answer = 42;
$a = $anonymous;
Which is why there's a but operator.
If you put something that is not a role on the right hand side of the does or but operators then an anonymous role will be auto-generated containing a single method that returns that value. The name of the method is determined by doing .WHAT.perl on the value supplied on the RHS. The generated role is then mixed in to the object. For example:
$x does 42
Is equivalent to:
$x does role { method Int() { return 42 } }
Note that the role has no attributes and thus no storage; if you want that, then you should instead use:
$x does Int(42)
Which mixes in the Int role and initializes the single storage location Int that it declares with 42, and provides an lvalue accessor.
Note that .WHAT on an enumeration value stringifies to the name of the enumeration, and as a result:
0 but True
Is equivalent to:
0 but role { method Bool() { return True } }
And thus the resulting value will be considered true in boolean context.
The list syntax for composing multiple roles in a single does or but by putting them in a list also applies here. Thus:
42 but ("the answer", False)
Is equivalent to:
42 but (role { method Str() { return "the answer" } },
role { method Bool() { return False } })
Which gives you a compact way to build context-sensitive return values. Note that multiple roles rather than a single one are generated, so that anything like:
42 but (True, False)
Will fail as a result of standard role composition semantics (because two roles are both trying to provide a method Bool).
From t/spec/S12-traits/basic.t lines 13–48 (no results): (skip)
| # L<S14/Traits>
|
| # Basic definition
|
| my $was_in_any_sub = 0;
|
| my $was_in_class_sub = 0;
|
| role cool {
|
| has $.is_cool = 42;
|
|
|
| multi sub trait_auxiliary:<is>(cool $trait, Any $container:) {
|
| $was_in_any_sub++;
|
| $container does cool;
|
| }
|
|
|
| multi sub trait_auxiliary:<is>(cool $trait, Class $container:) {
|
| $was_in_class_sub++;
|
| $container does cool;
|
| }
|
| }
|
| ok(::cool.HOW, "role definition worked");
|
|
|
| eval_lives_ok 'my $a is cool; 1', 'mixing in our role into a scalar via "is" worked';
|
| #?pugs 2 todo 'traits'
|
| is $was_in_any_sub, 1, 'trait_auxiliary:is was called on container';
|
| is eval('my $a is cool; $a.is_cool'), 42, 'our var "inherited" an attribute';
|
|
|
| my $b;
|
| class B is cool {}
|
| ok(::B.HOW, 'mixing in our role into a class via "is" worked');
|
| is $was_in_class_sub, 1, 'trait_auxiliary:is was called on class';
|
| $b = B.new;
|
| ok($b, 'creating an instance worked');
|
| is($b.is_cool, 42, 'our class "inherited" an attribute');
|
|
|
| eval_dies_ok(' %!P = 1; 1',
|
| 'calling a trait outside of a class should be a syntax error');
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
From t/spec/S12-traits/parameterized.t lines 13–34 (no results): (skip)
| # L<S14/Traits>
|
| # Basic definition
|
| role cool {
|
| has $.cool;
|
|
|
| multi sub trait_auxiliary:<is>(cool $trait, Any $container; $val) {
|
| $.cool = $val;
|
| $container does cool($val);
|
| }
|
| }
|
|
|
| my $a = 42;
|
| is $a, 42, "basic sanity (1)";
|
| lives_ok {$a does cool(23)}, "imperative does worked (1)";
|
| is $a.cool, 23, "attribute was set correctly (1)";
|
|
|
| my $b = 23;
|
| is $b, 23, "basic sanity (2)";
|
| ok $b does cool("hi"), "imperative does worked (2)";
|
| is $b.cool, "hi", "attribute was set correctly (2)";
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
From t/spec/S14-traits/package.t lines 6–47 (no results): (skip)
| # L<S14/Traits/>
|
|
|
| role description {
|
| has $.description is rw;
|
| }
|
|
|
| multi trait_mod:<is>(Class $c, description, $arg) {
|
| $c does description($arg);
|
| }
|
| multi trait_mod:<is>(Class $c, description) {
|
| $c does description("missing description!");
|
| }
|
| multi trait_mod:<is>(Class $c, $arg, :$described!) {
|
| $c does description($arg);
|
| }
|
| multi trait_mod:<is>(Class $c, :$described!) {
|
| $c does description("missing description!");
|
| }
|
|
|
|
|
| class Monkey is description('eats bananas, awesome') { }
|
| class Walrus is description { }
|
| is Monkey.HOW.description, 'eats bananas, awesome', 'description role applied to class and set with argument';
|
| is Walrus.HOW.description, 'missing description!', 'description role applied to class without argument';
|
|
|
| class Badger is described('mushroom mushroom') { }
|
| class Snake is described { }
|
| is Badger.HOW.description, 'mushroom mushroom', 'named trait handler applied other role to class set with argument';
|
| is Snake.HOW.description, 'missing description!', 'named trait handler applied other role to class without argument';
|
|
|
|
|
| role Nom is description('eats and eats') { }
|
| role Loser is description { }
|
| is Nom.HOW.description, 'eats and eats', 'description role applied to role and set with argument';
|
| is Loser.HOW.description, 'missing description!', 'description role applied to role without argument';
|
|
|
| role DamBuilding is described('dam good!') { }
|
| role Slither is described { }
|
| is DamBuilding.HOW.description, 'dam good!', 'named trait handler applied other role to role set with argument';
|
| is Slither.HOW.description, 'missing description!', 'named trait handler applied other role to role without argument';
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
From t/spec/S14-traits/attributes.t lines 6–49 (no results): (skip)
| # L<S14/Traits/>
|
|
|
| my @attr_names;
|
| multi trait_mod:<is>(AttributeDeclarand $a, :$noted!) {
|
| push @attr_names, $a.name;
|
| }
|
|
|
| role doc { has $.doc is rw }
|
| multi trait_mod:<is>(AttributeDeclarand $a, doc, $arg) {
|
| $a.container.VAR does doc($arg);
|
| }
|
|
|
|
|
| class T1 {
|
| has $!a is noted;
|
| }
|
| class T2 is T1 {
|
| has %!b is noted;
|
| has @!c is noted;
|
| }
|
|
|
| # Force class to create itself and thus apply the traits, for implementations
|
| # that do such things lazily.
|
| ok T2.new ~~ T2, 'class with traits applied to attributes by name instantiated ok';
|
| @attr_names .= sort;
|
| is +@attr_names, 3, 'have correct number of attributes';
|
| is @attr_names, ['$!a','%!b','@!c'], 'trait was applied to each attribute';
|
| T2.new;
|
| is +@attr_names, 3, 'second instantiation of the classes does not re-apply traits';
|
|
|
|
|
| class T3 {
|
| has $.dog is doc('barks');
|
| has @.birds is doc('tweet');
|
| has %.cows is doc('moooo');
|
| }
|
|
|
| my $x = T3.new;
|
| ok $x ~ T3, 'class with traits applied to attributes by role instantiated ok';
|
| is $x.dog.VAR.doc, 'barks', 'trait applied to scalar attribute correctly';
|
| is $x.birds.doc, 'tweet', 'trait applied to array attribute correctly';
|
| is $x.cows.doc, 'moooo', 'trait applied to hash attribute correctly';
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
From t/spec/S14-traits/variables.t lines 6–36 (no results): (skip)
| # L<S14/Traits/>
|
|
|
| my @var_names;
|
| multi trait_mod:<is>(ContainerDeclarand $a, :$noted!) {
|
| push @var_names, $a.name;
|
| }
|
|
|
| role doc { has $.doc is rw }
|
| multi trait_mod:<is>(ContainerDeclarand $a, doc, $arg) {
|
| $a.container.VAR does doc($arg);
|
| }
|
|
|
|
|
| my $a is noted;
|
| my %b is noted;
|
| my @c is noted;
|
|
|
| @var_names .= sort;
|
| is +@var_names, 3, 'have correct number of names noted from trait applied by name';
|
| is @var_names, ['$a','%b','@c'], 'trait recorded correct information';
|
|
|
|
|
| my $dog is doc('barks');
|
| my @birds is doc('tweet');
|
| my %cows is doc('moooo');
|
|
|
| is $dog.VAR.doc, 'barks', 'trait applied to scalar variable correctly';
|
| is @birds.doc, 'tweet', 'trait applied to array variable correctly';
|
| is %cows.doc, 'moooo', 'trait applied to hash variable correctly';
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
From t/spec/S14-traits/routines.t lines 6–57 (no results): (skip)
| # L<S14/Traits/>
|
|
|
| role description {
|
| has $.description is rw;
|
| }
|
|
|
| multi trait_mod:<is>(Routine $code, description, $arg) {
|
| $code does description($arg);
|
| }
|
| multi trait_mod:<is>(Routine $code, description) {
|
| $code does description("missing description!");
|
| }
|
| multi trait_mod:<is>(Routine $code, $arg, :$described!) {
|
| $code does description($arg);
|
| }
|
| multi trait_mod:<is>(Routine $code, :$described!) {
|
| $code does description("missing description!");
|
| }
|
|
|
|
|
| sub answer() is description('computes the answer') { 42 }
|
| sub faildoc() is description { "fail" }
|
| is answer(), 42, 'can call sub that has had a trait applied to it by role name with arg';
|
| is &answer.description, 'computes the answer', 'description role applied and set with argument';
|
| is faildoc(), "fail", 'can call sub that has had a trait applied to it by role name without arg';
|
| is &faildoc.description, 'missing description!', 'description role applied without argument';
|
|
|
| sub cheezburger is described("tasty") { "nom" }
|
| sub lolcat is described { "undescribable" }
|
|
|
| is cheezburger(), "nom", 'can call sub that has had a trait applied to it by named param with arg';
|
| is &cheezburger.description, 'tasty', 'named trait handler applied other role set with argument';
|
| is lolcat(), "undescribable", 'can call sub that has had a trait applied to it by named param without arg';
|
| is &lolcat.description, 'missing description!', 'named trait handler applied other role without argument';
|
|
|
| #?rakudo skip 'RT 69893'
|
| {
|
| my $recorder = '';
|
| role woowoo { }
|
| multi trait_mod:<is>(Routine $c, woowoo) {
|
| $c.wrap: sub {
|
| $recorder ~= 'wrap';
|
| }
|
| }
|
| sub foo is woowoo { };
|
| lives_ok &foo, 'Can call subroutine that was wrapped by a trait';
|
| is $recorder, 'wrap', 'and the wrapper has been called once';
|
| }
|
|
|
| done_testing();
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
Traits are just properties (roles) applied to something that is being declared (the declarand), such as containers or classes. It's the declaration of the item itself that makes traits seem more permanent than ordinary properties. In addition to adding the property, a trait can also have side effects.
Traits are generally applied with the "is" keyword, though not always. To define a trait handler for an "is xxx" trait, define one or more multisubs into a property role like this:
role xxx {
has Int $.xxx;
multi trait_mod:<is>(::?CLASS $declarand where {!.defined}, :$xxx!) {...}
multi trait_mod:<is>(Any $declarand, :$xxx!) {...}
}
Then it can function as a trait. A well-behaved trait handler will say
$declarand does xxx($arg);
somewhere inside to set the metadata on the declarand correctly. Since a class can function as a role when it comes to parameter type matching, you can also say:
class MyBase {
multi trait_mod:<is>(MyBase $declarand where {!.defined}, MyBase $base) {...}
multi trait_mod:<is>(Any $declarand, MyBase $tied) {...}
}
These capture control if MyBase wants to capture control of how it gets used by any class or container. But usually you can just let it call the generic defaults:
multi trait_mod:<is>($declarand where {!.defined}, $base) {...}
which adds $base to the "isa" list of class $declarand, or
multi trait_mod:<is>(Any $declarand, $tied) {...}
which sets the "tie" type of the container declarand to the implementation type in $tied.
Most traits are really just adverbial pairs which, instead of being introduce by a colon, are introduced by a (hopefully) more readable "helping verb", which could be something like "is", or "will", or "can", or "might", or "should", or "does". Any trait verb that is parsed the same as trait_mod:<is> may be defined the same way. Here's "will", which (being syntactic sugar) merely delegates to back to "is":
multi sub trait_mod:<will>($declarand, :$trait) {
trait_mod:<is>($declarand, :$trait);
}
Other traits are applied with a single word, and require special parsing. For instance, the "as" trait is defined something like this:
role as {
has ReturnType $.as;
multi sub trait_mod:<as>($declarand, ReturnType $arg) is parsed /<typename>/ {
$declarand does as($arg);
}
...
}
Unlike compile-time roles, which all flatten out in the same class, compile-time traits are applied one at a time, like mixin roles. You can, in fact, apply a trait to an object at run time, but if you do, it's just an ordinary mixin role. You have to call the appropriate trait_mod:<is()> routine yourself if you want it to do any extra shenanigans. The compiler won't call it for you at run time like it would at compile time.
Note that the declarations above are insufficient to install new trait auxilliaries or verbs into the user's grammar, since macro definitions are lexically scoped, and in the declarations above extend only to the end of the role definition. The user's lexical scope must somehow have processed (or imported) a proto declaration introducing the new syntax before it can be parsed correctly. (This doesn't apply to pre-existing syntax such as is, of course.)
From t/spec/S14-roles/parameterized-type.t lines 16–64 (no results): (skip)
| # L<S14/Parametric Roles>
|
| # L<S14/Relationship Between of And Types>
|
|
|
| role R1[::T] { method x { T } }
|
| class C1 does R1[Int] { }
|
| class C2 does R1[Str] { }
|
| lives_ok { my R1 of Int $x = C1.new }, 'using of as type constraint on variable works (class does role)';
|
| dies_ok { my R1 of Int $x = C2.new }, 'using of as type constraint on variable works (class does role)';
|
| lives_ok { my R1 of Int $x = R1[Int].new }, 'using of as type constraint on variable works (role instantiation)';
|
| dies_ok { my R1 of Int $x = R1[Str].new }, 'using of as type constraint on variable works (role instantiation)';
|
|
|
| sub param_test(R1 of Int $x) { $x.x }
|
| isa_ok param_test(C1.new), Int, 'using of as type constraint on parameter works (class does role)';
|
| dies_ok { param_test(C2.new) }, 'using of as type constraint on parameter works (class does role)';
|
| isa_ok param_test(R1[Int].new), Int, 'using of as type constraint on parameter works (role instantiation)';
|
| dies_ok { param_test(R1[Str].new) }, 'using of as type constraint on parameter works (role instantiation)';
|
|
|
| role R2[::T] {
|
| method x { "ok" }
|
| method call_test { self.call_test_helper(T.new) }
|
| method call_test_helper(T $x) { "ok" }
|
| method call_fail { self.call_test_helper(4.5) }
|
| }
|
| class C3 does R2[R2[Int]] { }
|
| class C4 does R2[R2[Str]] { }
|
|
|
| lives_ok { my R2 of R2 of Int $x = C3.new }, 'roles parameterized with themselves as type constraints';
|
| dies_ok { my R2 of R2 of Int $x = C4.new }, 'roles parameterized with themselves as type constraints';
|
| lives_ok { my R2 of R2 of Int $x = R2[R2[Int]].new }, 'roles parameterized with themselves as type constraints';
|
| dies_ok { my R2 of R2 of Int $x = R2[R2[Str]].new }, 'roles parameterized with themselves as type constraints';
|
|
|
| sub param_test_r(R2 of R2 of Int $x) { $x.x }
|
| is param_test_r(C3.new), 'ok', 'roles parameterized with themselves as type constraints';
|
| dies_ok { param_test_r(C4.new) }, 'roles parameterized with themselves as type constraints';
|
| is param_test_r(R2[R2[Int]].new), 'ok', 'roles parameterized with themselves as type constraints';
|
| dies_ok { param_test_r(R2[R2[Str]].new) }, 'roles parameterized with themselves as type constraints';
|
|
|
| is R2[Int].new.call_test, 'ok', 'types being used as type constraints inside roles work';
|
| dies_ok { R2[Int].new.call_fail }, 'types being used as type constraints inside roles work';
|
| is C3.new.call_test, 'ok', 'roles being used as type constraints inside roles work';
|
| dies_ok { C3.new.call_fail }, 'roles being used as type constraints inside roles work';
|
| is C4.new.call_test, 'ok', 'roles being used as type constraints inside roles work';
|
| dies_ok { C4.new.call_fail }, 'roles being used as type constraints inside roles work';
|
| is R2[C3].new.call_test, 'ok', 'classes being used as type constraints inside roles work';
|
| dies_ok { R2[C3].new.call_fail }, 'classes being used as type constraints inside roles work';
|
|
|
| #?pugs emit =end SKIP
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
A role's main type is generic by default, but you can also parameterize other types explicitly using type parameters:
From t/spec/S14-roles/parameterized-mixin.t lines 53–113 (no results): (skip)
| # L<S14/Parametric Roles/main type is generic by default>
|
| role InitialAttribType[::vartype] {
|
| method hi(vartype $foo) { 42 }
|
| }
|
| my $c;
|
| lives_ok { $c does InitialAttribType[Code] },
|
| "imperative does to apply a parametrized role (3)";
|
| ok $c.HOW.does($c, InitialAttribType),
|
| ".HOW.does gives correct information (3-1)";
|
| ok $c.^does(InitialAttribType),
|
| ".^does gives correct information (3-1)";
|
| ok $c.HOW.does($c, InitialAttribType[Code]),
|
| ".HOW.does gives correct information (3-2)";
|
| ok $c.^does(InitialAttribType[Code]),
|
| ".^does gives correct information (3-2)";
|
| is $c.hi(sub {}), 42,
|
| "type information was processed correctly (1)";
|
| dies_ok { $c.hi("not a code object") },
|
| "type information was processed correctly (2)";
|
|
|
|
|
| # Parameterized role using both a parameter which will add to the "long name"
|
| # of the role and one which doesn't.
|
| # (Explanation: This one is easier. The two attributes $.type and $.name will
|
| # be predefined (using the role parameterization). The $type adds to the long
|
| # name of the role, $name does not. Such:
|
| # my $a does InitialAttribBoth["foo", "bar"];
|
| # my $b does InitialAttribBoth["foo", "grtz"];
|
| # $a ~~ InitialAttribBoth ==> true
|
| # $b ~~ InitialAttribBoth ==> true
|
| # $a ~~ InitialAttribBoth["foo"] ==> true
|
| # $b ~~ InitialAttribBoth["foo"] ==> true
|
| # $a ~~ InitialAttribBoth["foo", "bar"] ==> false
|
| # $b ~~ InitialAttribBoth["foo", "grtz"] ==> false
|
| # Heavy stuff, eh?)
|
| role InitialAttribBoth[Str $type;; Str $name] {
|
| has $.type = $type;
|
| has $.name = $name;
|
| }
|
| my $d;
|
| lives_ok { $d does InitialAttribBoth["type1", "name1"] },
|
| "imperative does to apply a parametrized role (4)";
|
| ok $d.HOW.does($d, InitialAttribType),
|
| ".HOW.does gives correct information (4-1)";
|
| ok $d.^does(InitialAttribType),
|
| ".^does gives correct information (4-1)";
|
| #?rakudo 4 skip '.does with parametric roles'
|
| ok $d.HOW.does($d, InitialAttribType["type1"]),
|
| ".HOW.does gives correct information (4-2)";
|
| ok $d.^does(InitialAttribType["type1"]),
|
| ".^does gives correct information (4-2)";
|
| ok !$d.HOW.does($d, InitialAttribType["type1", "name1"]),
|
| ".HOW.does gives correct information (4-3)";
|
| ok !$d.^does(InitialAttribType["type1", "name1"]),
|
| ".^does gives correct information (4-3)";
|
| is $d.type, "type1", ".type works correctly";
|
| is $d.name, "name1", ".name works correctly";
|
|
|
| #?pugs emit =end SKIP
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
role Pet[::Petfood = TableScraps] {
method feed (Petfood $food) {...}
}
(Note that in this case you must not use ::Petfood in the inner declaration, or it would rebind the type to type of the actual food parameter.)
If you want to parameterize the initial value of a role attribute, be sure to put a double semicolon if you don't want the parameter to be considered part of the long name:
role Pet[::ID;; $tag] {
has ID $.collar .= new($tag);
}
You don't just have to parameterize on types; any value is fine. Imagine we wanted to factor out a "greet" method into a role, which takes somebody's name and greets them. We can parameterize it on the greeting.
role Greet[Str $greeting] {
method greet() { say "$greeting!"; }
}
class EnglishMan does Greet["Hello"] { }
class Slovak does Greet["Ahoj"] { }
class Lolcat does Greet["OH HAI"] { }
EnglishMan.new.greet(); # Hello
Slovak.new.greet(); # Ahoj
Lolcat.new.greet(); # OH HAI
Similarly, we could do a role for requests.
role Request[Str $statement] {
method request($object) { say "$statement $object?"; }
}
class EnglishMan does Request["Please can I have a"] { }
class Slovak does Request["Prosim si"] { }
class Lolcat does Request["I CAN HAZ"] { }
EnglishMan.new.request("yorkshire pudding");
Slovak.new.request("borovicka");
Lolcat.new.request("CHEEZEBURGER");
Sadly, the Slovak output sucks here. Borovicka is the nominative form of the word, and we need to decline it into the accusative case. But some languages don't care about that, and we don't want to have to make them all supply a transform. Thankfully, you can write many roles with the same short name, and a different signature, and multi-dispatch will pick the right one for you (it is the exact same dispatch algorithm used by multi-subs). So we can write:
role Request[Str $statement] {
method request($object) { say "$statement $object?"; }
}
role Request[Str $statement, &transform] {
method request($object) {
say "$statement " ~ transform($object) ~ "?";
}
}
module Language::Slovak {
sub accusative($nom) {
# ...and before some smartass points it out, I know
# I'm missing some of the masculine animate declension...
return $nom.subst(/a$/, 'u');
}
}
class EnglishMan does Request["Please can I have a"] { }
class Slovak does Request["Prosim si", &Language::Slovak::accusative] { }
class Lolcat does Request["I CAN HAZ"] { }
EnglishMan.new.request("yorkshire pudding");
Slovak.new.request("borovicka");
Lolcat.new.request("CHEEZEBURGER");
Which means we can now properly order our borovicka in Slovakia, which is awesome. Until you do it in a loop and find the Headache['very bad'] role got mixed into yourself overnight, anyway...
From t/spec/S14-roles/parameterized-type.t lines 17–64 (no results): (skip)
| # L<S14/Relationship Between of And Types>
|
|
|
| role R1[::T] { method x { T } }
|
| class C1 does R1[Int] { }
|
| class C2 does R1[Str] { }
|
| lives_ok { my R1 of Int $x = C1.new }, 'using of as type constraint on variable works (class does role)';
|
| dies_ok { my R1 of Int $x = C2.new }, 'using of as type constraint on variable works (class does role)';
|
| lives_ok { my R1 of Int $x = R1[Int].new }, 'using of as type constraint on variable works (role instantiation)';
|
| dies_ok { my R1 of Int $x = R1[Str].new }, 'using of as type constraint on variable works (role instantiation)';
|
|
|
| sub param_test(R1 of Int $x) { $x.x }
|
| isa_ok param_test(C1.new), Int, 'using of as type constraint on parameter works (class does role)';
|
| dies_ok { param_test(C2.new) }, 'using of as type constraint on parameter works (class does role)';
|
| isa_ok param_test(R1[Int].new), Int, 'using of as type constraint on parameter works (role instantiation)';
|
| dies_ok { param_test(R1[Str].new) }, 'using of as type constraint on parameter works (role instantiation)';
|
|
|
| role R2[::T] {
|
| method x { "ok" }
|
| method call_test { self.call_test_helper(T.new) }
|
| method call_test_helper(T $x) { "ok" }
|
| method call_fail { self.call_test_helper(4.5) }
|
| }
|
| class C3 does R2[R2[Int]] { }
|
| class C4 does R2[R2[Str]] { }
|
|
|
| lives_ok { my R2 of R2 of Int $x = C3.new }, 'roles parameterized with themselves as type constraints';
|
| dies_ok { my R2 of R2 of Int $x = C4.new }, 'roles parameterized with themselves as type constraints';
|
| lives_ok { my R2 of R2 of Int $x = R2[R2[Int]].new }, 'roles parameterized with themselves as type constraints';
|
| dies_ok { my R2 of R2 of Int $x = R2[R2[Str]].new }, 'roles parameterized with themselves as type constraints';
|
|
|
| sub param_test_r(R2 of R2 of Int $x) { $x.x }
|
| is param_test_r(C3.new), 'ok', 'roles parameterized with themselves as type constraints';
|
| dies_ok { param_test_r(C4.new) }, 'roles parameterized with themselves as type constraints';
|
| is param_test_r(R2[R2[Int]].new), 'ok', 'roles parameterized with themselves as type constraints';
|
| dies_ok { param_test_r(R2[R2[Str]].new) }, 'roles parameterized with themselves as type constraints';
|
|
|
| is R2[Int].new.call_test, 'ok', 'types being used as type constraints inside roles work';
|
| dies_ok { R2[Int].new.call_fail }, 'types being used as type constraints inside roles work';
|
| is C3.new.call_test, 'ok', 'roles being used as type constraints inside roles work';
|
| dies_ok { C3.new.call_fail }, 'roles being used as type constraints inside roles work';
|
| is C4.new.call_test, 'ok', 'roles being used as type constraints inside roles work';
|
| dies_ok { C4.new.call_fail }, 'roles being used as type constraints inside roles work';
|
| is R2[C3].new.call_test, 'ok', 'classes being used as type constraints inside roles work';
|
| dies_ok { R2[C3].new.call_fail }, 'classes being used as type constraints inside roles work';
|
|
|
| #?pugs emit =end SKIP
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
The of keyword is just syntactic sugar for providing a single parameter to a parametric type. Thus:
my Array of Recipe %book;
Actually means:
my Array[Recipe] %book;
This can be nested, so:
my Hash of Array of Recipe @library;
Is just:
my Hash[Array[Recipe]] @library;
Therefore:
my Array @array;
Means an Array of Array (actually, a Positional of Array).
From t/spec/S14-roles/parameter-subtyping.t lines 10–64 (no results): (skip)
| # L<S14/Parametric Subtyping>
|
|
|
| role R1[::T] { }
|
| role R1[::T1, ::T2] { }
|
| class C1 { }
|
| class C2 is C1 { }
|
| class C3 { }
|
|
|
| # Subtyping with a single role parameter which is a class type.
|
| ok(R1[C1] ~~ R1, 'basic sanity');
|
| ok(R1[C1] ~~ R1[C1], 'basic sanity');
|
| ok(R1[C2] ~~ R1[C1], 'subtyping by role parameters (one param)');
|
| ok(R1[C1] !~~ R1[C2], 'subtyping by role parameters (one param)');
|
| ok(R1[C3] !~~ R1[C1], 'subtyping by role parameters (one param)');
|
|
|
| # Subtyping with nested roles.
|
| ok(R1[R1[C1]] ~~ R1, 'basic sanity');
|
| #?rakudo 4 skip 'smart-matching'
|
| ok(R1[R1[C1]] ~~ R1[R1[C1]], 'basic sanity');
|
| ok(R1[R1[C2]] ~~ R1[R1[C1]], 'subtyping by role parameters (nested)');
|
| ok(R1[R1[C1]] !~~ R1[R1[C2]], 'subtyping by role parameters (nested)');
|
| ok(R1[R1[C3]] !~~ R1[R1[C1]], 'subtyping by role parameters (nested)');
|
|
|
| # Subtyping with multiple role parameters.
|
| ok(R1[C1,C3] ~~ R1, 'basic sanity');
|
| #?rakudo 6 skip 'smart-matching'
|
| ok(R1[C1,C3] ~~ R1[C1,C3], 'basic sanity');
|
| ok(R1[C2,C3] ~~ R1[C1,C3], 'subtyping by role parameters (two params)');
|
| ok(R1[C2,C2] ~~ R1[C1,C1], 'subtyping by role parameters (two params)');
|
| ok(R1[C1,C1] !~~ R1[C2,C2], 'subtyping by role parameters (two params)');
|
| ok(R1[C1,C2] !~~ R1[C2,C1], 'subtyping by role parameters (two params)');
|
| ok(R1[C2,C1] !~~ R1[C1,C3], 'subtyping by role parameters (two params)');
|
|
|
| # Use of parametric subtyping in dispatch.
|
| sub s(C1 @arr) { 1 }
|
| multi m(C1 @arr) { 2 }
|
| multi m(@arr) { 3 }
|
| my C2 @x;
|
| is(s(@x), 1, 'single dispatch relying on parametric subtype');
|
| is(m(@x), 2, 'multi dispatch relying on parametric subtype');
|
|
|
| # Real types enforced.
|
| sub modify(C1 @arr) {
|
| @arr[0] = C1.new;
|
| }
|
| dies_ok({ modify(@x) }, 'type constraints enforced properly');
|
|
|
| # Use of parametric subtyping for assignment.
|
| my Num @a;
|
| my Int @b = 1,2;
|
| lives_ok({ @a = @b }, 'assignment worked as expected');
|
| #?rakudo skip 'weird error'
|
| is(@a[0], 1, 'assignment worked as expected');
|
|
|
| # vim: ft=perl6
|
Highlighted:
small|full
If you have two types in a subtyping relationship such that T1 is narrower than T2, then also the roles:
role R[::T] { }
role R[::T1, ::T2] { }
Will act such that R[T1] is narrower than R[T2]. This extends to multiple parameters, however they must all be narrower or the same (this is unlike in multiple dispatch where you can have one narrower and the rest narrower or tied). That is, assuming we have some unrelated type T3, then R[T2, T1] is narrower than R[T1,T1] but R[T2,T1] is not narrower than R[T1,T3].
Nesting follows naturally from this definition, so a role R[R[T2]] is narrower than a role R[R[T1]].
This all means that, for example, if you have a sub:
sub f(Num @arr) { ... }
Then you can also call it with an array of Int.
my Int @a = 1,2,3;
f(@a);
Certainly so far as Perl 6.0.0 goes, only types that have been declared on a container count in the type check. That is, if we have a sub:
sub f(Int @arr) { ... }
And call it with any of:
f([1,2,3]);
my @a = 1,2,3;
f(@a);
Then neither of these calls will work. The type check is based on the declared type of the array, and the content is unknown to the type checker.
[ Top ]
[ Index of Synopses ]