Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

192 lines (151 sloc) 6.941 kB
use v6;
use Test;
plan 51;
# type based dispatching
#
#L<S06/"Longname parameters">
#L<S12/"Multisubs and Multimethods">
multi foo (5) { "Constant" }
multi foo (Int $bar) { "Int " ~ $bar }
multi foo (Str $bar) { "Str " ~ $bar }
multi foo (Rat $bar) { "Rat " ~ $bar }
multi foo (Bool $bar) { "Bool " ~ $bar }
multi foo (Regex $bar) { "Regex " ~ WHAT( $bar ) } # since Rule's don't stringify
multi foo (Sub $bar) { "Sub " ~ $bar() }
multi foo (@bar) { "Positional " ~ join(', ', @bar) }
multi foo (%bar) { "Associative " ~ join(', ', %bar.keys.sort) }
multi foo (IO $fh) { "IO" } #OK not used
multi foo (Inf) { "Inf" }
multi foo (NaN) { "NaN" }
is foo(5), 'Constant', 'dispatched to the constant sub';
is(foo(2), 'Int 2', 'dispatched to the Int sub');
is(foo('test'), 'Str test', 'dispatched to the Str sub');
my $num = '4';
is(foo(1.4), 'Rat 1.4', 'dispatched to the Num sub');
is(foo(1 == 1), 'Bool ' ~ True, 'dispatched to the Bool sub');
is(foo(/a/),'Regex Regex()','dispatched to the Rule sub');
is(foo(sub { 'baz' }), 'Sub baz', 'dispatched to the Sub sub');
my @array = ('foo', 'bar', 'baz');
is(foo(@array), 'Positional foo, bar, baz', 'dispatched to the Positional sub');
my %hash = ('foo' => 1, 'bar' => 2, 'baz' => 3);
is(foo(%hash), 'Associative bar, baz, foo', 'dispatched to the Associative sub');
is(foo($*ERR), 'IO', 'dispatched to the IO sub');
is foo(Inf), 'Inf', 'dispatched to the Inf sub';
is foo(NaN), 'NaN', 'dispatched to the NaN sub';
# You're allowed to omit the "sub" when declaring a multi sub.
# L<S06/"Routine modifiers">
multi declared_wo_sub (Int $x) { 1 } #OK not used
multi declared_wo_sub (Str $x) { 2 } #OK not used
is declared_wo_sub(42), 1, "omitting 'sub' when declaring 'multi sub's works (1)";
is declared_wo_sub("42"), 2, "omitting 'sub' when declaring 'multi sub's works (2)";
# Test for slurpy MMDs
proto mmd {} # L<S06/"Routine modifiers">
multi mmd () { 1 }
multi mmd (*$x, *@xs) { 2 } #OK not used
is(mmd(), 1, 'Slurpy MMD to nullary');
is(mmd(1,2,3), 2, 'Slurpy MMD to listop via args');
is(mmd(1..3), 2, 'Slurpy MMD to listop via list');
{
my %h = (:a<b>, :c<d>);
multi sub sigil-t (&code) { 'Callable' } #OK not used
multi sub sigil-t ($any) { 'Any' } #OK not used
multi sub sigil-t (@ary) { 'Positional' } #OK not used
multi sub sigil-t (%h) { 'Associative' } #OK not used
is sigil-t(1), 'Any', 'Sigil-based dispatch (Any)';
is sigil-t({ $_ }), 'Callable', 'Sigil-based dispatch (Callable)';
is sigil-t(<a b c>), 'Positional','Sigil-based dispatch (Arrays)';
is sigil-t(%h), 'Associative','Sigil-based dispatch (Associative)';
}
{
class Scissor { }
class Paper { }
class Stone { }
multi wins(Scissor $x, Paper $y) { 1 } #OK not used
multi wins(::T $x, T $y) { 0 } #OK not used
multi wins($x, $y) { -1 } #OK not used
is wins(Scissor.new, Paper.new), 1, 'Basic sanity';
is wins(Paper.new, Paper.new), 0, 'multi dispatch with ::T generics';
is wins(Paper.new, Scissor.new), -1, 'fallback if there is a ::T variant';
multi wins2(Scissor $x, Paper $y) { 1 } #OK not used
multi wins2($x, $y where { $x.WHAT eq $y.WHAT }) { 0 }
multi wins2($x, $y) { -1 } #OK not used
is wins2(Scissor.new, Paper.new), 1, 'Basic sanity 2';
is wins2(Paper.new, Paper.new), 0, 'multi dispatch with faked generics';
is wins2(Paper.new, Scissor.new), -1, 'fallback if there is a faked generic';
# now try again with anonymous parameters (see RT #69798)
multi wins_anon(Scissor $, Paper $) { 1 }
multi wins_anon(Paper $, Stone $) { 1 }
multi wins_anon(Stone $, Scissor $) { 1 }
multi wins_anon(::T $, T $) { 0 }
multi wins_anon( $, $) { -1 }
is wins_anon(Scissor, Paper), 1, 'MMD with anonymous parameters (1)';
is wins_anon(Paper, Paper), 0, 'MMD with anonymous parameters (2)';
is wins_anon(Stone, Paper), -1, 'MMD with anonymous parameters (3)';
}
{
multi m($x,$y where { $x==$y }) { 0 }
multi m($x,$y) { 1 } #OK not used
is m(2, 3), 1, 'subset types involving mulitple parameters (fallback)';
is m(1, 1), 0, 'subset types involving mulitple parameters (success)';
}
{
multi f2 ($) { 1 }
multi f2 ($, $) { 2 }
multi f2 ($, $, $) { 3 }
multi f2 ($, $, @) { '3+' }
is f2(3), 1, 'arity-based dispatch to ($)';
is f2('foo', f2(3)), 2, 'arity-based dispatch to ($, $)';
is f2('foo', 4, 8), 3, 'arity-based dispatch to ($, $, $)';
is f2('foo', 4, <a b>), '3+', 'arity-based dispatch to ($, $, @)';
}
{
multi f3 ($ where 0 ) { 1 }
multi f3 ($x) { $x + 1 }
is f3(0), 1, 'can dispatch to "$ where 0"';
is f3(3), 4, '... and the ordinary dispatch still works';
}
# multi dispatch on typed containers
#?rakudo skip 'typed array and hash containers are NYI'
{
multi f4 (Int @a ) { 'Array of Int' } #OK not used
multi f4 (Str @a ) { 'Array of Str' } #OK not used
multi f4 (Array @a) { 'Array of Array' } #OK not used
multi f4 (Int %a) { 'Hash of Int' } #OK not used
multi f4 (Str %a) { 'Hash of Str' } #OK not used
multi f4 (Array %a) { 'Hash of Array' } #OK not used
my Int @a = 3, 4;
my Str @b = <foo bar>;
my Array @c = [1, 2], [3, 4];
my Int %a = a => 1, b => 2;
my Str %b = :a<b>, :b<c>;
my Array %c = a => [1, 2], b => [3, 4];
is f4(%a), 'Hash of Int', 'can dispatch on typed Hash (Int)';
is f4(%b), 'Hash of Str', 'can dispatch on typed Hash (Str)';
is f4(%c), 'Hash of Array', 'can dispatch on typed Hash (Array)';
is f4(@a), 'Array of Int', 'can dispatch on typed Array (Int)';
is f4(@b), 'Array of Str', 'can dispatch on typed Array (Str)';
is f4(@c), 'Array of Array', 'can dispatch on typed Array (Array)';
}
# make sure that multi sub dispatch also works if the sub is defined
# in a class (was a Rakudo regression, RT #65674)
{
class A {
our multi sub a(Int $x) { 'Int ' ~ $x }
our multi sub a(Str $x) { 'Str ' ~ $x }
}
is A::a(3), 'Int 3', 'multis in classes (1)';
is A::a('f'), 'Str f', 'multis in classes (2)';
dies_ok { A::a([4, 5]) }, 'multis in classes (3)';
}
{
multi x(@a, @b where { @a.elems == @b.elems }) { 1 }
multi x(@a, @b) { 2 } #OK not used
is x([1,2],[3,4]), 1, 'where-clause that uses multiple params (1)';
is x([1],[2,3,4]), 2, 'where-clause that uses multiple params (1)';
multi y(::T $x, T $y) { 1 } #OK not used
multi y($x, $y) { 2 } #OK not used
is y(1, 2), 1, 'generics in multis (+)';
is y(1, 2.5), 2, 'generics in multis (-)';
}
done;
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.