call-method.rakutest.vw2twB5P

use MONKEY-SEE-NO-EVAL;
use experimental :rakuast;
use Test;

plan 18;

my $ast;
my $deparsed;
my @type = <AST Str AST Str>;
sub ast(RakuAST::Node:D $node --> Nil) {
    $ast      := $node;
    $deparsed := $node.DEPARSE;
    diag $deparsed.chomp;
}

sub no-args() {
    444
}
subtest 'Can make a named call with no arguments' => {
    # no-args()
    ast RakuAST::Call::Name.new(
      name => RakuAST::Name.from-identifier('no-args')
    );
    is-deeply $deparsed, 'no-args()', 'deparsed';
    is-deeply $_, 444, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

sub one-arg($x) {
    9 * $x
}
subtest 'Can make a named call with one positional argument' => {
    # one-arg(5)
    ast RakuAST::Call::Name.new(
      name => RakuAST::Name.from-identifier('one-arg'),
      args => RakuAST::ArgList.new(RakuAST::IntLiteral.new(5))
    );
    is-deeply $deparsed, 'one-arg(5)', 'deparsed';
    is-deeply $_, 45, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

sub two-args($x, $y) {
    $x - $y
}
subtest 'Can make a named call with two positional arguments' => {
    # two-args(5, 3)
    ast RakuAST::Call::Name.new(
      name => RakuAST::Name.from-identifier('two-args'),
      args => RakuAST::ArgList.new(
        RakuAST::IntLiteral.new(5),
        RakuAST::IntLiteral.new(3),
      )
    );
    is-deeply $deparsed, 'two-args(5, 3)', 'deparsed';
    is-deeply $_, 2, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

sub two-named(:$n1, :$n2) {
    $n1 / $n2
}
subtest 'Can make a named call with two named arguments' => {
    # two-named(n1 => 200, n2 => 4)
    ast RakuAST::Call::Name.new(
      name => RakuAST::Name.from-identifier('two-named'),
      args => RakuAST::ArgList.new(
        RakuAST::FatArrow.new(
          key => 'n1',
          value => RakuAST::IntLiteral.new(200)
        ),
        RakuAST::FatArrow.new(
          key => 'n2',
          value => RakuAST::IntLiteral.new(4)
        )
      )
    );
    is-deeply $deparsed, 'two-named(n1 => 200, n2 => 4)', 'deparsed';
    is-deeply $_, 50.0, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Duplicated named arguments are correctly handled' => {
    # two-named(n1 => 200, n2 => 4, n1 => 400)
    ast RakuAST::Call::Name.new(
      name => RakuAST::Name.from-identifier('two-named'),
      args => RakuAST::ArgList.new(
        RakuAST::FatArrow.new(
          key => 'n1',
          value => RakuAST::IntLiteral.new(200)
        ),
        RakuAST::FatArrow.new(
          key => 'n2',
          value => RakuAST::IntLiteral.new(4)
        ),
        RakuAST::FatArrow.new(
          key => 'n1',
          value => RakuAST::IntLiteral.new(400)
        ),
      )
    );
    is-deeply $deparsed, 'two-named(n1 => 200, n2 => 4, n1 => 400)', 'deparsed';
    is-deeply $_, 100.0, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

my $target = -> $a, $b { $a - $b }
subtest 'Can make a call on a term with two positional arguments' => {
    # $target(9, 4)
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::Var::Lexical.new('$target'),
      postfix => RakuAST::Call::Term.new(
        args => RakuAST::ArgList.new(
          RakuAST::IntLiteral.new(9),
          RakuAST::IntLiteral.new(4),
        )
      )
    );
    is-deeply $deparsed, '$target(9, 4)', 'deparsed';
    is-deeply $_, 5, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

class TestTarget {
    my $.route = 66;
    method subtract($x, $y) { $x - $y }
}
subtest 'Can make a call on a method without arguments' => {
    # TestTarget.route()
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::Type::Simple.new(
        RakuAST::Name.from-identifier('TestTarget')
      ),
      postfix => RakuAST::Call::Method.new(
        name => RakuAST::Name.from-identifier('route')
      )
    );
    is-deeply $deparsed, 'TestTarget.route()', 'deparsed';
    is-deeply $_, 66, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Can make a call on a method with positional arguments' => {
    # TestTarget.subtract(14, 6)
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::Type::Simple.new(
        RakuAST::Name.from-identifier('TestTarget')
      ),
      postfix => RakuAST::Call::Method.new(
        name => RakuAST::Name.from-identifier('subtract'),
        args => RakuAST::ArgList.new(
          RakuAST::IntLiteral.new(14),
          RakuAST::IntLiteral.new(6),
        )
      )
    );
    is-deeply $deparsed, 'TestTarget.subtract(14, 6)', 'deparsed';
    is-deeply $_, 8, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Method call WHAT compiles into MOP primitive' => {
    # 42.WHAT
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::IntLiteral.new(42),
      postfix => RakuAST::Call::Method.new(
        name => RakuAST::Name.from-identifier('WHAT')
      )
    );
    is-deeply $deparsed, '42.WHAT', 'deparsed';
    is-deeply $_, Int, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Method call HOW compiles into MOP primitive' => {
    # 42.HOW
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::IntLiteral.new(42),
      postfix => RakuAST::Call::Method.new(
        name => RakuAST::Name.from-identifier('HOW')
      )
    );
    is-deeply $deparsed, '42.HOW', 'deparsed';
    is-deeply $_, Int.HOW, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Method call WHO compiles into MOP primitive' => {
    # 42.WHO
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::IntLiteral.new(42),
      postfix => RakuAST::Call::Method.new(
        name => RakuAST::Name.from-identifier('WHO')
      )
    );
    is-deeply $deparsed, '42.WHO', 'deparsed';
    isa-ok $_, Stash, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Method call DEFINITE compiles into MOP primitive' => {
    # 42.DEFINITE
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::IntLiteral.new(42),
      postfix => RakuAST::Call::Method.new(
        name => RakuAST::Name.from-identifier('DEFINITE')
      )
    );
    is-deeply $deparsed, '42.DEFINITE', 'deparsed';
    is-deeply $_, True, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Method call REPR compiles into MOP primitive' => {
    # 42.REPR
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::IntLiteral.new(42),
      postfix => RakuAST::Call::Method.new(
        name => RakuAST::Name.from-identifier('REPR')
      )
    );
    is-deeply $deparsed, '42.REPR', 'deparsed';
    is-deeply $_, 'P6opaque', @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Can make a quoted call on a method without arguments' => {
    # TestTarget."route"()
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::Type::Simple.new(
        RakuAST::Name.from-identifier('TestTarget')
      ),
      postfix => RakuAST::Call::QuotedMethod.new(
        name => RakuAST::QuotedString.new(
          :segments[RakuAST::StrLiteral.new('route')]
        )
      )
    );
    is-deeply $deparsed, 'TestTarget."route"()', 'deparsed';
    is-deeply $_, 66, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Can make a quoted call on a method with positional arguments' => {
    # TestTarget."subtract"(14, 6)
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::Type::Simple.new(
        RakuAST::Name.from-identifier('TestTarget')
      ),
      postfix => RakuAST::Call::QuotedMethod.new(
        name => RakuAST::QuotedString.new(
          :segments[RakuAST::StrLiteral.new('subtract')]
        ),
        args => RakuAST::ArgList.new(
          RakuAST::IntLiteral.new(14),
          RakuAST::IntLiteral.new(6),
        )
      )
    );
    is-deeply $deparsed, 'TestTarget."subtract"(14, 6)', 'deparsed';
    is-deeply $_, 8, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Can make a meta-method call' => {
    # 42.^name()
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::IntLiteral.new(42),
      postfix => RakuAST::Call::MetaMethod.new(name => 'name')
    );
    is-deeply $deparsed, '42.^name()', 'deparsed';
    is-deeply $_, 'Int', @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Can make a call that flattens into array' => {
    my @args;
    # no-args(|@args)
    ast RakuAST::Call::Name.new(
      name => RakuAST::Name.from-identifier('no-args'),
      args => RakuAST::ArgList.new(
        RakuAST::ApplyPrefix.new(
          prefix => RakuAST::Prefix.new('|'),
          operand => RakuAST::Var::Lexical.new('@args')
        )
      )
    );
    is-deeply $deparsed, 'no-args(|@args)', 'deparsed';
    is-deeply $_, 444, "@type[$++]: flattening empty list"
      for EVAL($ast), EVAL($deparsed);

    @args = 95, 40;
    # two-args(|@args)
    ast RakuAST::Call::Name.new(
      name => RakuAST::Name.from-identifier('two-args'),
      args => RakuAST::ArgList.new(
        RakuAST::ApplyPrefix.new(
          prefix => RakuAST::Prefix.new('|'),
          operand => RakuAST::Var::Lexical.new('@args')
        )
      )
    );
    is-deeply $deparsed, 'two-args(|@args)', 'deparsed';
    is-deeply $_, 55, "@type[$++]: two positional arguments"
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Can make a call that flattens into hash' => {
    my %args;
    # no-args(|%args)
    ast RakuAST::Call::Name.new(
      name => RakuAST::Name.from-identifier('no-args'),
      args => RakuAST::ArgList.new(
        RakuAST::ApplyPrefix.new(
          prefix => RakuAST::Prefix.new('|'),
          operand => RakuAST::Var::Lexical.new('%args')
        )
      )
    );
    is-deeply $deparsed, 'no-args(|%args)', 'deparsed';
    is-deeply $_, 444, "@type[$++]: flattening empty list"
      for EVAL($ast), EVAL($deparsed);

    %args<n1 n2> = 60, 12;
    # two-named(|%args)
    ast RakuAST::Call::Name.new(
      name => RakuAST::Name.from-identifier('two-named'),
      args => RakuAST::ArgList.new(
        RakuAST::ApplyPrefix.new(
          prefix => RakuAST::Prefix.new('|'),
          operand => RakuAST::Var::Lexical.new('%args')
        )
      )
    );
    is-deeply $deparsed, 'two-named(|%args)', 'deparsed';
    is-deeply $_, 5.0, "@type[$++]: flattening two named arguments"
      for EVAL($ast), EVAL($deparsed);
}

# vim: expandtab shiftwidth=4