infix.t

useTest;
plan50;

{
subinfix:<×> ($a, $b) { $a+$b }
is(5 × 3, 8, "infix Unicode operator (actual overloading)");
}

{
subinfix:<C> ($text, $owner) { return"$text copyright $owner"; };
is"romeo & juliet" C "Shakespeare", "romeo & juliet copyright Shakespeare",
'infix operator overloading for new operator';
}

{
subinfix:<©> ($text, $owner) { return"$text Copyright $owner"; };
is"romeo & juliet" © "Shakespeare", "romeo & juliet Copyright Shakespeare",
'infix operator overloading for new operator (unicode)';
}

{
subinfix:<(C)> ($text, $owner) { return"$text CopyRight $owner"; };
isEVAL(q[ "romeo & juliet" (C) "Shakespeare" ]), "romeo & juliet CopyRight Shakespeare",
'infix operator overloading for new operator (nasty)';
}

{
subinfix:«_<_ »($one, $two) { return42 } #OK not used
is3 _<_ 5, 42, "frenchquoted infix sub";
}

# unfreak perl6.vim: >>

# Overloading by setting the appropriate code variable
# https://github.com/Raku/old-issue-tracker/issues/4128
#?rakudo skip "cannot bind with this LHS"
{
my&infix:<plus>;
BEGIN {
&infix:<plus> := { $^a+$^b };
 }

is3 plus 5, 8, 'overloading an operator using "my &infix:<...>" worked';
}

# Overloading by setting the appropriate code variable using symbolic
# dereferentiation
{
my&infix:<times>;
BEGIN {
 &::("infix:<times>") = { $^a*$^b };
 }

is3times5, 15, 'operator overloading using symbolic dereferentiation';
}

# Accessing an operator using its subroutine name
{
is&infix:<+>(2, 3), 5, "accessing a builtin operator using its subroutine name";

my&infix:<z> := { $^a+$^b };
is&infix:<z>(2, 3), 5, "accessing a userdefined operator using its subroutine name";

is~(&infix:<»+«>([1,2,3],[4,5,6])), "5 7 9", "accessing a hyperoperator using its subroutine name";
}

# Overriding infix:<;>
#?rakudo todo 'infix:<;>'
{
my proto infix:<;> ($a, $b) { $a+$b }
is$(3 ; 2), 5# XXX correct?
}

# here is one that co-erces a MyClass into a Str and a Num.
{
classOtherClass {
has$.xisrw;
 }

classMyClass {
methodprefix:<~> isexport { "hi" }
methodprefix:<+> isexport { 42 }
methodinfix:<as>($self: OtherClass $to) isexport { #OK not used
my$obj=$to.new;
$obj.x=23;
return$obj;
 }
 }
 import MyClass; # should import that sub forms of the exports

my$obj;
lives-ok { $obj= MyClass.new }, "instantiation of a prefix:<...> and infix:<as> overloading class worked";
lives-ok { ~$obj }, "our object can be stringified";
is~$obj, "hi", "our object was stringified correctly";
isEVAL('($obj as OtherClass).x'), 23, "our object was coerced correctly";
}

# https://github.com/Raku/old-issue-tracker/issues/4131
#?rakudo skip 'infix Z will never work; no lexical Z RT #124983'
{
mysubinfix:<Z> ($a, $b) {
$a**$b;
 }
is (2Z1Z2), 4, "default Left-associative works.";
}

# https://github.com/Raku/old-issue-tracker/issues/4131
#?rakudo skip 'no lexical Z RT #124983'
{
mysubinfix:<Z> ($a, $b) isassoc('left') {
$a**$b;
 }

is (2Z1Z2), 4, "Left-associative works.";
}

# https://github.com/Raku/old-issue-tracker/issues/4131
#?rakudo skip 'no lexical Z RT #124983'
{
mysubinfix:<Z> ($a, $b) isassoc('right') {
$a**$b;
 }

is (2Z1Z2), 2, "Right-associative works.";
}

# https://github.com/Raku/old-issue-tracker/issues/4131
#?rakudo skip 'no lexical Z RT #124983'
{
mysubinfix:<Z> ($a, $b) isassoc('chain') {
$aeq$b;
 }


is (1Z1Z1), Bool::True, "Chain-associative works.";
is (1Z1Z2), Bool::False, "Chain-associative works.";
}

{
subinfix:<our_non_assoc_infix> ($a, $b) isassoc('non') {
$a**$b;
 }
is (2 our_non_assoc_infix 3), (2**3), "Non-associative works for just tow operands.";
is ((2 our_non_assoc_infix 2) our_non_assoc_infix 3), (2**2) **3, "Non-associative works when used with parens.";
throws-like'2 our_non_assoc_infix 3 our_non_assoc_infix 4',
X::Syntax::NonAssociative,
"Non-associative should not parsed when used chainly.";
}

{
roleA { has$.v }
multisubinfix:<==>(A $a, A $b) { $a.v ==$b.v }
lives-ok { 3==3ordie() }, 'old == still works on integers (+)';
lives-ok { 3==4anddie() }, 'old == still works on integers (-)';
ok (A.new(v =>3) == A.new(v =>3)), 'infix:<==> on A objects works (+)';
ok!(A.new(v =>2) == A.new(v =>3)), 'infix:<==> on A objects works (-)';
}

{
multisubinfix:<+=> (Int$aisrw, Int$b) { $a-=$b }
my$frew=10;
$frew+=5;
is$frew, 5, 'infix redefinition of += works';
}

{
classMMDTestType {
has$.aisrw;
methodadd(MMDTestType $b) { $.a~$b.a }
 }

multisubinfix:<+>(MMDTestType $a, MMDTestType $b) { $a.add($b) };

my MMDTestType $a.=new(a=>'foo');
my MMDTestType $b.=new(a=>'bar');

is$a+$b, 'foobar', 'can overload exiting operators (here: infix:<+>)';
}

# test that multis with other arity don't interfere with existing ones
# https://github.com/Raku/old-issue-tracker/issues/993
# used to be RT #65640
{
multisubinfix:<+>() { 42 };
ok5+5==10, "New multis don't disturb old ones";
}

# https://github.com/Raku/old-issue-tracker/issues/992
{
isEVAL('sub infix:<,>($a, $b) { 42 }; 5, 5'), 42, 'infix:<,>($a, $b)';
isEVAL('sub infix:<,>(Int $x where 1, Int $y where 1) { 42 }; 1, 1'), 42,
'very specific infix:<,>';
#?rakudo todo 'RT #65638'
isEVAL('sub infix:<#>($a, $b) { 42 }; 5 # 5'), 42, 'infix:<comment char>($a, $b)';
isEVAL('multi sub infix:<+>() { 42 }; 5 + 5'), 10, 'infix:<+>()';
isEVAL('sub infix:<+>($a, $b) { 42 }; 5 + 5'), 42, 'infix:<+>($a, $b)';
}

{
multisubinfix:<foo>($a, $b) {$a+$b};

# autoviv tries to call &[foo]() with no arguments, so we define first
# alternative is below, with a candidate with an empty parameter list
my$x=0;
$x foo=6;
is$x, 6, 'foo= works for custom operators';
}

{
multisubinfix:<foo>($a, $b) {$a+$b};
multisubinfix:<foo>() { 0 };

# alternative with a candidate with an empty parameter list
my$x foo=6;
is$x, 6, 'foo= works for custom operators';
}

{
oursubinfix:<bar>($a, $b) {$a+$b};

# similar to above, but without the empty param candidate
my$x=0;
$x bar=6;
is$x, 6, 'bar= works for custom operators';

}

# https://github.com/Raku/old-issue-tracker/issues/1669
{
classRT74104 {}
multisubinfix:<+>(RT74104 $, RT74104 $) { -1 }
is2+2, 4, 'overloading an operator does not hide other candidates';
}

# https://github.com/Raku/old-issue-tracker/issues/2656
# https://github.com/Raku/old-issue-tracker/issues/2760
{
subinfix:<*+>($a, $b) { $a*$b+$b }
is2*+5, 15, 'longest operator wins (RT #111418)';
subinfix:<~eq>(Str$a, Str$b) { uc($a) equc($b) }
ok'a'~eq'A', 'longest operator wins (RT #112870)';
}

# https://github.com/Raku/old-issue-tracker/issues/2639
{
my&infix:<c> = { $^a+$^b };
is1 c 2, 3, 'assignment to code variable works.';
}

isinfix:['+'](2,3), 5, 'can call existing infix via compile-time string lookup';
isinfix:['Z~'](<a b>, <c d>), 'ac bd', 'can call autogen infix via compile-time string lookup';

# https://github.com/Raku/old-issue-tracker/issues/1183
{
BEGINmy$plus='+';
is&infix:<<$plus>>(3,4), 7, '&infix:<<$foo>> works';
is&infix:«$plus»(3,4), 7, '&infix:«$foo» works';
is&infix:[$plus](3,4), 7, '&infix:[$foo] works';
}

# https://github.com/rakudo/rakudo/issues/3895
{
my%calls;
mysubinfix:<==⨧>($a,$b) {
my$ans=so$a==$b+2;
push%calls<plain>,
"$a ==⨧ $b→$ans";
$ans
 }
mysubinfix:<is-eq⨧>($a,$b) isequiv(&infix:<==>) {
my$ans=so$a==$b+2;
push%calls<is-eq⨧>,
"$a ==⨧ $b→$ans";
$ans
 }

ok!(6==⨧ 4==⨧ 2), "Custom operator doesn't chain";
ok!(6 is-eq⨧ 4 is-eq⨧ 2),
"Custom operator with precedence same as == still doesn't chain";
is-deeply%calls<plain>, %calls<is-eq⨧>, "Both are called the same";
}

# vim: expandtab shiftwidth=4