Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

202 lines (151 sloc) 5.42 kb
use v6;
use Test;
plan 42;
# L<S03/Invocant marker/"will apply the :xxx adverb">
sub prefix:<blub> (Str $foo, Int :$times = 1) {
("BLUB" x $times) ~ $foo;
}
is prefix:<blub>("bar"), 'BLUBbar', 'user-defined prefix operator, long name';
is prefix:<blub>("bar", times => 2), 'BLUBBLUBbar', 'user-defined prefix operator, long name, optional parameter';
is prefix:<blub>(:times(2), "bar"), 'BLUBBLUBbar', 'user-defined prefix operator, long name, :times adverb, leading';
is prefix:<blub>("bar", :times(2)), 'BLUBBLUBbar', 'user-defined prefix operator, long name, :times adverb, trailing';
is blub "bar", 'BLUBbar', 'user-defined prefix operator, basic call';
is blub "bar" :times(2), 'BLUBBLUBbar', 'user-defined prefix operator, :times adverb, space';
is blub "bar":times(2), 'BLUBBLUBbar', 'user-defined prefix operator, :times adverb, no space';
{
# These basic adverb tests are copied from a table in A12.
my $bar = 123;
my @many = (4,5);
sub dostuff(){"stuff"}
my ($v,$e);
$e = (foo => $bar);
$v = :foo($bar);
is ~$v, ~$e, ':foo($bar)';
$e = (foo => [1,2,3,@many]);
$v = :foo[1,2,3,@many];
is ~$v, ~$e, ':foo[1,2,3,@many]';
$e = (foo => «alice bob charles»);
$v = :foo«alice bob charles»;
is ~$v, ~$e, ':foo«alice bob charles»';
$e = (foo => 'alice');
$v = :foo«alice»;
is ~$v, ~$e, ':foo«alice»';
$e = (foo => { a => 1, b => 2 });
$v = EVAL ':foo{ a => 1, b => 2 }';
is ~$v, ~$e, ':foo{ a => 1, b => 2 }';
$e = (foo => { dostuff() });
$v = :foo{ dostuff() };
is ~$v, ~$e, ':foo{ dostuff() }';
$e = (foo => 0);
$v = :foo(0);
is ~$v, ~$e, ':foo(0)';
$e = (foo => Bool::True);
$v = :foo;
is ~$v, ~$e, ':foo';
}
# Exercise various mixes of "fiddle", parens "()",
# and adverbs with "X' and without "x" an argument.
sub violin($x) {
if $x ~~ Bool {
$x ?? "1" !! "0";
} else {
$x;
}
}
sub fiddle(:$x,:$y){ violin($x) ~ violin($y) }
#?niecza skip 'Multi colonpair syntax not yet understood'
{
# fiddle(XY) fiddle(YX) fiddle(xY) fiddle(Xy)
is fiddle(:x("a"):y("b")), "ab", 'fiddle(:x("a"):y("b"))';
is fiddle(:y("b"):x("a")), "ab", 'fiddle(:y("b"):x("a"))';
is fiddle(:x:y("b")), "1b", 'fiddle(:x:y("b"))';
is fiddle(:x("a"):y), "a1", 'fiddle(:x("a"):y)';
}
{
# fiddle(X)Y fiddle(Y)X fiddle(x)Y fiddle(X)y fiddle(x)y
is fiddle(:x("a")):y("b"), "ab", 'fiddle(:x("a")):y("b")';
is fiddle(:y("b")):x("a"), "ab", 'fiddle(:y("b")):x("a")';
is fiddle(:x):y("b"), "1b", 'fiddle(:x("a")):y("b")';
is fiddle(:x("a")):y, "a1", 'fiddle(:x("a")):y';
is fiddle(:x):y, "11", 'fiddle(:x):y';
}
{
# fiddle()XY fiddle()YX fiddle()xY fiddle()Xy fiddle()xy
is fiddle():x("a"):y("b"), "ab", 'fiddle():x("a"):y("b")';
is fiddle():y("b"):x("a"), "ab", 'fiddle():y("b"):x("a")';
is fiddle():x:y("b"), "1b", 'fiddle():x:y("b")';
is fiddle():x("a"):y, "a1", 'fiddle():x("a"):y';
is fiddle():x:y, "11", 'fiddle():x:y';
}
{
# f_X(Y) f_X_Y() f_X_Y_() f_XY_() f_XY() fXY ()
# $v = fiddle :x("a")(:y("b"));
# is $v, "ab", 'fiddle :x("a")(:y("b"))';
# Since the demagicalizing of pairs, this test shouldn't and doesn't work any
# longer.
# $v = 'EVAL failed';
# EVAL '$v = fiddle :x("a") :y("b")()';
# is $v, "ab", 'fiddle :x("a") :y("b")()';
# $v = 'EVAL failed';
# EVAL '$v = fiddle :x("a") :y("b") ()';
# is $v, "ab", 'fiddle :x("a") :y("b") ()';
# $v = 'EVAL failed';
# EVAL '$v = fiddle :x("a"):y("b") ()';
# is $v, "ab", 'fiddle :x("a"):y("b") ()';
# $v = 'EVAL failed';
# EVAL '$v = fiddle :x("a"):y("b")()';
# is $v, "ab", 'fiddle :x("a"):y("b")()';
# $v = fiddle:x("a"):y("b") ();
# is $v, "ab", 'fiddle:x("a"):y("b") ()';
}
{
# Exercise mixes of adverbs and positional arguments.
my $v;
my sub f($s,:$x) { violin($x) ~ violin($s) }
my sub g($s1,$s2,:$x) {$s1~$x~$s2}
my sub h(*@a) {@a.perl}
my sub i(*%h) {%h.perl}
my sub j($s1,$s2,*%h) {$s1~%h.perl~$s2}
# f(X s) f(Xs) f(s X) f(sX) f(xs) f(sx)
is f(:x("a"), "b"), "ab", 'f(:x("a") "b")';
is f(:x("a"),"b"), "ab", 'f(:x("a")"b")';
is f("b", :x("a")), "ab", 'f("b" :x("a"))';
is f("b",:x("a")), "ab", 'f("b":x("a"))';
is f(:x, "b"), "1b", 'f(:x "b")';
is f("b", :x), "1b", 'f("b" :x)';
# f(s)X
is f("b"):x("a"), "ab", 'f("b"):x("a")';
# fs X fsX fs x fsx
# $v = f "b" :x("a");
# is $v, "ab", 'f "b" :x("a")';
# $v = f "b":x("a");
# is $v, "ab", 'f "b":x("a")';
# $v = f "b" :x;
# is $v, "1b", 'f "b" :x';
# $v = f "b":x;
# is $v, "1b", 'f "b":x';
# add more tests...
}
#?niecza skip 'Multi colonpair syntax not yet understood'
#?rakudo todo 'Multi colonpair syntax not yet understood RT #124553'
{ # adverbs as pairs
my sub f1($s,:$x){$s.perl~$x}
is f1(\:bar :x("b")), '("bar" => Bool::True)b', 'f1(\:bar :x("b"))';
}
{
# adverbs as pairs, cont.
my sub f2(Pair $p){$p.perl}
is f2((:bar)), ("bar" => Bool::True).perl, 'f2((:bar))';
my sub f3(Pair $p1, Pair $p2){$p1.perl~" - "~$p2.perl}
is f3((:bar),(:hee(3))), "{(bar => Bool::True).perl} - {(hee => 3).perl}", 'f3((:bar),(:hee(3)))';
}
{
# Exercise adverbs on operators.
sub prefix:<zpre>($a,:$x){join(",",$a,$x)}
is (zpre 4 :x(5)), '4,5', '(zpre 4 :x(5))';
sub postfix:<zpost>($a,:$x){join(",",$a,$x)}
is (4zpost :x(5)), '4,5', '(4 zpost :x(5))';
sub infix:<zin>($a,$b,:$x){join(",",$a,$b,$x)}
is (3 zin 4 :x(5)), '3,4,5', '(3 zin 4 :x(5))';
}
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.