* (merge)

Copied (with git history): call.rakutest — into: — call-method.rakutest
rakudo · Jan 12, 2023 · 3b0a08b · 3b0a08b
2 parents 35e498e + 91a1020
commit 3b0a08b
Showing 1 changed file with 340 additions and 0 deletions.
diff --git a/t/12-rakuast/call-method.rakutest 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 = <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