diff --git a/t/12-rakuast/call-method.rakutest b/t/12-rakuast/call-method.rakutest new file mode 100644 index 00000000000..55edd27c7f4 --- /dev/null +++ b/t/12-rakuast/call-method.rakutest @@ -0,0 +1,340 @@ +use MONKEY-SEE-NO-EVAL; +use experimental :rakuast; +use Test; + +plan 18; + +my $ast; +my $deparsed; +my @type = ; +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 = 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