operators.rakutest

use v6.e.PREVIEW;
use Test;

plan 31;

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

subtest 'Application of an infix operator on two literals' => {
    # 44 + 22
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(44),
      infix => RakuAST::Infix.new('+'),
      right => RakuAST::IntLiteral.new(22)
    );

    is-deeply $deparsed, '44 + 22', 'deparse';
    is-deeply $_, 66, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'The special form || operator works (1)' => {
    # 22 || 44
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(22),
      infix => RakuAST::Infix.new('||'),
      right => RakuAST::IntLiteral.new(44)
    );

    is-deeply $deparsed, '22 || 44', 'deparse';
    is-deeply $_, 22, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'The special form || operator works (2)' => {
    # 0 || 44
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(0),
      infix => RakuAST::Infix.new('||'),
      right => RakuAST::IntLiteral.new(44)
    );

    is-deeply $deparsed, '0 || 44', 'deparse';
    is-deeply $_, 44, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'The special form or operator works (1)' => {
    # 22 or 44
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(22),
      infix => RakuAST::Infix.new('or'),
      right => RakuAST::IntLiteral.new(44)
    );

    is-deeply $deparsed, '22 or 44', 'deparse';
    is-deeply $_, 22, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'The special form or operator works (2)' => {
    # 0 or 44
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(0),
      infix => RakuAST::Infix.new('or'),
      right => RakuAST::IntLiteral.new(44)
    );

    is-deeply $deparsed, '0 or 44', 'deparse';
    is-deeply $_, 44, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'The special form && operator works (1)' => {
    # 22 && 44
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(22),
      infix => RakuAST::Infix.new('&&'),
      right => RakuAST::IntLiteral.new(44)
    );

    is-deeply $deparsed, '22 && 44', 'deparse';
    is-deeply $_, 44, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'The special form && operator works (2)' => {
    # 0 && 44
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(0),
      infix => RakuAST::Infix.new('&&'),
      right => RakuAST::IntLiteral.new(44)
    );

    is-deeply $deparsed, '0 && 44', 'deparse';
    is-deeply $_, 0, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'The special form and operator works (1)' => {
    # 22 and 44
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(22),
      infix => RakuAST::Infix.new('and'),
      right => RakuAST::IntLiteral.new(44)
    );

    is-deeply $deparsed, '22 and 44', 'deparse';
    is-deeply $_, 44, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'The special form and operator works (2)' => {
    # 0 and 44
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(0),
      infix => RakuAST::Infix.new('and'),
      right => RakuAST::IntLiteral.new(44)
    );

    is-deeply $deparsed, '0 and 44', 'deparse';
    is-deeply $_, 0, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Application of a prefix operator to a literal (1)' => {
    # ?2
    ast RakuAST::ApplyPrefix.new(
      prefix => RakuAST::Prefix.new('?'),
      operand => RakuAST::IntLiteral.new(2)
    );

    is-deeply $deparsed, '?2', 'deparse';
    is-deeply $_, True, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Application of a prefix operator to a literal (2)' => {
    # ?0
    ast RakuAST::ApplyPrefix.new(
      prefix => RakuAST::Prefix.new('?'),
      operand => RakuAST::IntLiteral.new(0)
    );

    is-deeply $deparsed, '?0', 'deparse';
    is-deeply $_, False, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Application of a positive power postfix operator' => {
    # 3²²
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::IntLiteral.new(3),
      postfix => RakuAST::Postfix::Power.new(22)
    );

    is-deeply $deparsed, '3²²', 'deparse';
    is-deeply $_, 31381059609, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Application of a negative power postfix operator' => {
    # 4⁻²
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::IntLiteral.new(4),
      postfix => RakuAST::Postfix::Power.new(-2)
    );

    is-deeply $deparsed, '4⁻²', 'deparse';
    is-deeply $_, 0.0625, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Application of a (user-defined) postfix operator to a literal' => {
    sub postfix:<!>($n) {
        [*] 1..$n
    }

    # 4!
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::IntLiteral.new(4),
      postfix => RakuAST::Postfix.new('!'),
    );

    is-deeply $deparsed, '4!', 'deparse';
    is-deeply $_, 24, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Basic assignment to a Scalar container' => {
    my $a = 1;

    # $a = 4
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::Var::Lexical.new('$a'),
      infix => RakuAST::Infix.new('='),
      right => RakuAST::IntLiteral.new(4)
    );

    is-deeply $deparsed, '$a = 4', 'deparse';
    is-deeply EVAL($ast), 4, @type[$++];
    $a = 666;
    is-deeply EVAL($deparsed), 4, @type[$++];
}

subtest 'Basic single-dimension array index' => {
    my @a = 10..20;

    # @a[5]
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::Var::Lexical.new('@a'),
      postfix => RakuAST::Postcircumfix::ArrayIndex.new(
        index => RakuAST::SemiList.new(
          RakuAST::Statement::Expression.new(
            expression => RakuAST::IntLiteral.new(5)
          )
        )
      )
    );

    is-deeply $deparsed, '@a[5]', 'deparse';
    is-deeply $_, 15, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Zen array slice' => {
    my @a = 10..20;

    # @a[]
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::Var::Lexical.new('@a'),
      postfix => RakuAST::Postcircumfix::ArrayIndex.new(
        index => RakuAST::SemiList.new
      )
    );

    is-deeply $deparsed, '@a[]', 'deparse';
    is-deeply $_, @a, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Multi-dimensional array indexing' => {
    my @a[3;3] = <a b c>, <d e f>, <g h i>;

    # @a[2;1]
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::Var::Lexical.new('@a'),
      postfix => RakuAST::Postcircumfix::ArrayIndex.new(
        index => RakuAST::SemiList.new(
          RakuAST::Statement::Expression.new(
            expression => RakuAST::IntLiteral.new(2)
          ),
          RakuAST::Statement::Expression.new(
            expression => RakuAST::IntLiteral.new(1)
          )
        )
      )
    );

    is-deeply $deparsed, '@a[2; 1]', 'deparse';
    is-deeply $_, 'h', @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

{
    my %h = a => 'add', s => 'subtract';

    subtest 'Basic single-dimension hash index' => {
        # %h{"s")}
        ast RakuAST::ApplyPostfix.new(
          operand => RakuAST::Var::Lexical.new('%h'),
          postfix => RakuAST::Postcircumfix::HashIndex.new(
            RakuAST::SemiList.new(
              RakuAST::Statement::Expression.new(
                expression => RakuAST::StrLiteral.new('s')
              )
            )
          )
        );

        is-deeply $deparsed, '%h{"s"}', 'deparse';
        is-deeply $_, 'subtract', @type[$++]
          for EVAL($ast), EVAL($deparsed);
    }

    subtest 'Zen hash slice' => {
        # %h{}
        ast RakuAST::ApplyPostfix.new(
          operand => RakuAST::Var::Lexical.new('%h'),
          postfix => RakuAST::Postcircumfix::HashIndex.new(
            RakuAST::SemiList.new
          )
        );

        is-deeply $deparsed, '%h{}', 'deparse';
        is-deeply $_, %h, @type[$++]
          for EVAL($ast), EVAL($deparsed);
    }

    subtest 'Basic literal hash index' => {
        # %h<s>
        ast RakuAST::ApplyPostfix.new(
          operand => RakuAST::Var::Lexical.new('%h'),
          postfix => RakuAST::Postcircumfix::LiteralHashIndex.new(
            index => RakuAST::QuotedString.new(
              segments => [RakuAST::StrLiteral.new('s')],
              processors => ['words','val']
            )
          )
        );

        is-deeply $deparsed, '%h<s>', 'deparse';
        is-deeply $_, 'subtract', @type[$++]
          for EVAL($ast), EVAL($deparsed);
    }

    subtest 'Literal hash index with multiple keys' => {
        # %h<s a>
        ast RakuAST::ApplyPostfix.new(
          operand => RakuAST::Var::Lexical.new('%h'),
          postfix => RakuAST::Postcircumfix::LiteralHashIndex.new(
            index => RakuAST::QuotedString.new(
              segments => [RakuAST::StrLiteral.new('s a')],
              processors => ['words','val']
            )
          )
        );

        is-deeply $deparsed, '%h<s a>', 'deparse';
        is-deeply $_, ('subtract', 'add'), @type[$++]
          for EVAL($ast), EVAL($deparsed);
    }

    subtest 'Empty literal hash index works as zen slice' => {
        # %h<>
        ast RakuAST::ApplyPostfix.new(
          operand => RakuAST::Var::Lexical.new('%h'),
          postfix => RakuAST::Postcircumfix::LiteralHashIndex.new(
            index => RakuAST::QuotedString.new(
              segments => [RakuAST::StrLiteral.new('')],
              processors => ['words','val']
            )
          )
        );

        is-deeply $deparsed, '%h<>', 'deparse';
        is-deeply $_, %h, @type[$++]
          for EVAL($ast), EVAL($deparsed);
    }
}

subtest 'Multi-dimensional hash indexing' => {
    my %h = x => { :1a, :2b }, y => { :3a, :4b };

    # %h{'y';'a'}
    ast RakuAST::ApplyPostfix.new(
      operand => RakuAST::Var::Lexical.new('%h'),
      postfix => RakuAST::Postcircumfix::HashIndex.new(
        RakuAST::SemiList.new(
          RakuAST::Statement::Expression.new(
            expression => RakuAST::StrLiteral.new('y')
          ),
          RakuAST::Statement::Expression.new(
            expression => RakuAST::StrLiteral.new('a')
          )
        )
      )
    );

    is-deeply $deparsed, '%h{"y"; "a"}', 'deparse';
    is-deeply $_, 3, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Application of a list infix operator on three operands' => {
    # 10, 11, 12
    ast RakuAST::ApplyListInfix.new(
      infix => RakuAST::Infix.new(','),
      operands => (
        RakuAST::IntLiteral.new(10),
        RakuAST::IntLiteral.new(11),
        RakuAST::IntLiteral.new(12),
      )
    );

    is-deeply $deparsed, '10, 11, 12', 'deparse';
    is-deeply $_, (10, 11, 12), @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Application of a list infix operator on no operands' => {
    # ()
    ast RakuAST::Circumfix::Parentheses.new(
      RakuAST::SemiList.new(
        RakuAST::Statement::Expression.new(
          expression => RakuAST::ApplyListInfix.new(
            infix => RakuAST::Infix.new(','),
            operands => ()
          )
        )
      )
    );

    is-deeply $deparsed, '()', 'deparse';
    is-deeply $_, (), @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Chaining operator has correct outcome' => {
    my $x = 4;

    # 5 > $x++ > 3
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::ApplyInfix.new(
        left => RakuAST::IntLiteral.new(5),
        infix => RakuAST::Infix.new('>'),
        right => RakuAST::ApplyPostfix.new(
          postfix => RakuAST::Postfix.new('++'),
          operand => RakuAST::Var::Lexical.new('$x')
        )
      ),
      infix => RakuAST::Infix.new('>'),
      right => RakuAST::IntLiteral.new(3)
    );
    is-deeply $deparsed, '5 > $x++ > 3', 'deparse';

    is-deeply EVAL($ast), True, @type[$++];
    is-deeply $x, 5;

    $x = 4;
    is-deeply EVAL($deparsed), True, @type[$++];
    is-deeply $x, 5;
}

subtest 'Correct outcome of ternary operator' => {
    # $a ?? 22 !! 33
    ast RakuAST::Ternary.new(
      condition => RakuAST::Var::Lexical.new('$a'),
      then => RakuAST::IntLiteral.new(22),
      else => RakuAST::IntLiteral.new(33)
    );
    is-deeply $deparsed, '$a ?? 22 !! 33', 'deparse';

    my $a = 1;
    is-deeply $_, 22, @type[$++]
      for EVAL($ast), EVAL($deparsed);

    $a = 0;
    is-deeply $_, 33, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Application of dotty infix `.`' => {
    # "foo" .uc()
    ast RakuAST::ApplyDottyInfix.new(
      left => RakuAST::StrLiteral.new('foo'),
      infix => RakuAST::DottyInfix::Call.new(),
      right => RakuAST::Call::Method.new(
        name => RakuAST::Name.from-identifier('uc')
      )
    );

    is-deeply $deparsed, '"foo" .uc()', 'deparse';
    is-deeply $_, 'FOO', @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

subtest 'Application of dotty infix `.=` evaluates to expected value' => {
    my $var = 'foo';

    # $var .= tc()
    ast RakuAST::ApplyDottyInfix.new(
      left => RakuAST::Var::Lexical.new('$var'),
      infix => RakuAST::DottyInfix::CallAssign.new(),
      right => RakuAST::Call::Method.new(
        name => RakuAST::Name.from-identifier('tc')
      )
    );
    is-deeply $deparsed, '$var .= tc()', 'deparse';

    is-deeply EVAL($ast), 'Foo', @type[$++];
    is-deeply $var, 'Foo';

    $var = 'foo';
    is-deeply EVAL($deparsed), 'Foo', @type[$++];
    is-deeply $var, 'Foo';
}

subtest 'Application of a function infix on two literals' => {
    # 44 [&sum] 22
    ast RakuAST::ApplyInfix.new(
      left => RakuAST::IntLiteral.new(44),
      infix => RakuAST::FunctionInfix.new(
        RakuAST::Var::Lexical.new('&sum')
      ),
      right => RakuAST::IntLiteral.new(22)
    );

    is-deeply $deparsed, '44 [&sum] 22', 'deparse';
    is-deeply $_, 66, @type[$++]
      for EVAL($ast), EVAL($deparsed);
}

# vim: expandtab shiftwidth=4