use Test; plan 13;
# L<S12/"Calling Sets of Methods">
# L<S12/"Roles">
# Spec:
# For any method name, there may be some number of candidate methods that could
# handle the request: typically, inherited methods or multi variants. The
# ordinary "dot" operator dispatches to a method in the standard fashion. There
# are also "dot" variants that call some number of methods with the same name:
# $object.?meth # calls method if there is one, otherwise undef
class Parent {
has Int $.cnt is rw;
does plugin_1;
does plugin_2;
method meth {++$.cnt}
}
class Child is Parent {
method meth {++$.cnt}
method child_only {'child_only'}
}
role plugin_1 { multi method init_hook { $.cnt += 2 } }
role plugin_2 { multi method init_hook { $.cnt += 3 } }
{
my $test = q"$object.?meth calls method if there is one";
my $object = Child.new;
my $result = 1; # default to one to see if value changes to undef
try { $result = $object.?nope };
ok($object.?meth, $test);
is($result,undef, q" ..undef otherwise ");
# TODO: add test for $object.?$meth (dynamic method) as well
}
{
my $test = q"$object.*meth(@args) # calls all methods (0 or more)";
my $object = Child.new;
my $result = 1; # default to one to see if value changes to undef
try { $result = $object.*nope };
is($result,undef, q"$test: Case 0 returns undef");
try { $result = $object.*child_only };
is($result, 'child_only', "$test: Case 1 finds one result");
try { $result = $object.*meth };
is($object.cnt, 2, "$test: Case 2 visits both Child and Parent");
my $meth = 'meth';
$object = Child.new;
try { $result = $object.*$meth };
is($object.cnt, 2, "$test: Case 2 visits both Child and Parent (as dynamic method call)");
my $meth = 'sqrt';
my $ans = 0;
try { $ans = 4.*$meth };
is($ans, 2, q"$obj.*$meth works built-in methods like 'sqrt'");
}
{
# We should not only look in parent classes, but for matching
# multi methods in parent classes!
my $test = q"$object.*meth(@args) # calls all methods (0 or more) works on multi axis, too";
my $object = Child.new;
my $got = 0;
my $meth = 'init_hook';
try { $got = $object.*$meth };
is($got, 5, $test, :todo<feature>);
}
{
my $test = q"$object.+meth(@args) # calls all methods (1 or more)";
my $object = Child.new;
my $result = 1; # default to one to see if value changes to undef
try { $result = $object.+nope };
ok($!, q"$test: Case 0 dies");
try { $result = $object.+child_only };
is($result, 'child_only', "$test: Case 1 fines one result");
try { $result = $object.+meth };
is($object.cnt, 2, "$test: Case 2 visits both Child and Parent");
# TODO: add test for $object.+$meth (dynamic method) as well
}
ok(0,q'STUB: $object.*WALK[:breadth:omit($?CLASS)]::meth(@args);', :todo<feature> );
ok(0, "STUB: there is more Calling Sets functionality which needs tests", :todo<feature>);
# vim: ft=perl6