The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
use strict;
use warnings;
use Test::More;

use Text::Xslate;

BEGIN {
    package Text::Xslate::Syntax::Custom;
    use Mouse;
    extends 'Text::Xslate::Parser';

    sub init_symbols {
        my $self = shift;

        $self->SUPER::init_symbols(@_);

        $self->symbol('merge_hash')->set_nud($self->can('nud_merge_hash'));
    }

    sub nud_merge_hash {
        my $self = shift;
        my ($symbol) = @_;

        $self->advance('(');
        my $base = $self->expression(0);
        $self->advance(',');
        my $value = $self->expression(0);
        $self->advance(')');

        return $symbol->clone(
            arity  => 'merge_hash',
            first  => $base,
            second => $value,
        );
    }

    package Text::Xslate::Compiler::Custom;
    use Mouse;
    extends 'Text::Xslate::Compiler';

    sub _generate_merge_hash {
        my $self = shift;
        my ($node) = @_;

        my $lvar_id = $self->lvar_id;
        local $self->{lvar_id} = $self->lvar_use(1);

        return (
            $self->compile_ast($node->first),
            $self->opcode('save_to_lvar', $lvar_id),
            $self->compile_ast($node->second),
            $self->opcode('move_to_sb'),
            $self->opcode('load_lvar', $lvar_id),
            $self->opcode('merge_hash'),
        );
    }

    package Text::Xslate::Custom;
    use base 'Text::Xslate';

    sub options {
        my $class = shift;

        my $options = $class->SUPER::options(@_);

        $options->{compiler} = 'Text::Xslate::Compiler::Custom';
        $options->{syntax}   = 'Custom';

        return $options;
    }
}

my $tx = Text::Xslate::Custom->new;

my @tests = (
    [ ': [ merge_hash($a, $b).foo, $a.foo, $b.foo ].map(-> $elem { defined($elem) ? $elem : "undef" }).join(" ")', 'FOO FOO undef' ],
    [ ': [ merge_hash($b, $a).foo, $a.foo, $b.foo ].map(-> $elem { defined($elem) ? $elem : "undef" }).join(" ")', 'FOO FOO undef' ],
    [ ': [ merge_hash($a, $b).bar, $a.bar, $b.bar ].map(-> $elem { defined($elem) ? $elem : "undef" }).join(" ")', 'RAB BAR RAB' ],
    [ ': [ merge_hash($b, $a).bar, $a.bar, $b.bar ].map(-> $elem { defined($elem) ? $elem : "undef" }).join(" ")', 'BAR BAR RAB' ],
    [ ': [ merge_hash($a, $b).baz, $a.baz, $b.baz ].map(-> $elem { defined($elem) ? $elem : "undef" }).join(" ")', 'ZAB undef ZAB' ],
    [ ': [ merge_hash($b, $a).baz, $a.baz, $b.baz ].map(-> $elem { defined($elem) ? $elem : "undef" }).join(" ")', 'ZAB undef ZAB' ],
);

for my $test (@tests) {
    is(
        $tx->render_string(
            $test->[0],
            {
                a => {
                    foo => 'FOO',
                    bar => 'BAR',
                },
                b => {
                    bar => 'RAB',
                    baz => 'ZAB',
                },
            }
        ),
        $test->[1],
        $test->[0]
    );
}

done_testing;