The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict; use warnings FATAL => 'all';
use Test::More;

use DTL::Fast::Expression;
use DTL::Fast::Context;
use Data::Dumper;

my $exp;

# @todo Tests for hash values
# @todo Tests for array values
# @todo Tests for objecs with methods: div, mul, plus, minus, not, compare

my $COMPARE_NUM_SET = [ # compare numeric values
    {'val1' => 3.14, 'val2' => 3.14 },
    {'val1' => 3.14, 'val2' => 3.15 },
    {'val1' => 3.15, 'val2' => 3.14 },
    {'val1' => -3.14, 'val2' => 3.14 },
    {'val1' => -3.14, 'val2' => 3.15 },
    {'val1' => -3.15, 'val2' => 3.14 },
    {'val1' => 3.14, 'val2' => -3.14 },
    {'val1' => 3.14, 'val2' => -3.15 },
    {'val1' => 3.15, 'val2' => -3.14 },
    {'val1' => -3.14, 'val2' => -3.14 },
    {'val1' => -3.14, 'val2' => -3.15 },
    {'val1' => -3.15, 'val2' => -3.14 },
    
    # auhtor tests, issue #93
    #{'val1' => undef, 'val2' => -3.14 },
    #{'val1' => -3.15, 'val2' => undef },
    #{'val1' => undef, 'val2' => undef },
    
];

my $STRING_SET = [ # compare and operate string and mixed values
    {'val1' => 'abc', 'val2' => 'def' },
    {'val1' => 'def', 'val2' => 'abc' },
    {'val1' => '', 'val2' => 'def' },
    {'val1' => 'def', 'val2' => '' },
    {'val1' => 'abc', 'val2' => 3.14 },
    {'val1' => 3.14, 'val2' => 'abc' },
    
    # auhtor tests, issue #93
    #{'val1' => undef, 'val2' => 'abc' },
    #{'val1' => 'abc', 'val2' => undef },
    #{'val1' => undef, 'val2' => undef },
];

my $LOGICAL_SET = [ # logical operations
    {'val1' => 0, 'val2' => 0 },
    {'val1' => 0, 'val2' => 1 },
    {'val1' => 1, 'val2' => 0 },
    {'val1' => 1, 'val2' => 1 },
    {'val1' => '', 'val2' => '' },
    {'val1' => '', 'val2' => 'bingo' },
    {'val1' => 'bingo', 'val2' => '' },
    {'val1' => 'bingo', 'val2' => 'bingo' },
    {'val1' => 0, 'val2' => '' },
    {'val1' => 0, 'val2' => 'bingo' },
    {'val1' => 1, 'val2' => '' },
    {'val1' => 1, 'val2' => 'bingo' },
    {'val1' => '', 'val2' => 0 },
    {'val1' => '', 'val2' => 1 },
    {'val1' => 'bingo', 'val2' => 0 },

    # auhtor tests, issue #93
    #{'val1' => undef, 'val2' => 1 },
    #{'val1' => 1, 'val2' => undef },
    #{'val1' => undef, 'val2' => undef },
];

my $NUMERIC_SET = [    # math operations
    {'val1' => 3.14, 'val2' => 15.92},
    {'val1' => -3.14, 'val2' => 15.92},
    {'val1' => 3.14, 'val2' => -15.92},
    {'val1' => -3.14, 'val2' => -15.92},
    {'val1' => 0, 'val2' => 15.92},
    {'val1' => 0, 'val2' => -15.92},
    {'val1' => 3.14, 'val2' => 0},
    {'val1' => -3.14, 'val2' => 0},
    {'val1' => 0, 'val2' => 0},

    # auhtor tests, issue #93
    #{'val1' => undef, 'val2' => 0},
    #{'val1' => 0, 'val2' => undef},
    #{'val1' => undef, 'val2' => undef},
];

my $NUMERIC_SET_DIV = [    # math operations without division by zero
    {'val1' => 3.14, 'val2' => 15.92},
    {'val1' => -3.14, 'val2' => 15.92},
    {'val1' => 3.14, 'val2' => -15.92},
    {'val1' => -3.14, 'val2' => -15.92},
    {'val1' => 0, 'val2' => 15.92},
    {'val1' => 0, 'val2' => -15.92},
    # modulus
    {'val1' => 42, 'val2' => 15},
    {'val1' => 0, 'val2' => 15},
    {'val1' => 0, 'val2' => -15},
    {'val1' => -42, 'val2' => 15},
    {'val1' => 42, 'val2' => -15},

    # auhtor tests, issue #93
    #{'val1' => undef, 'val2' => -15},
    #{'val1' => 42, 'val2' => undef},
    #{'val1' => undef, 'val2' => undef},
];
        
my $samples = [
################################################################################
    {
        'template' => 'val1 ** val2'
        , 'context' => $NUMERIC_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} ** $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'not val1'
        , 'context' => $LOGICAL_SET
        , 'control' => sub{
            my $c = shift;
            return( not $c->{'val1'});
        }
    },
################################################################################
    {
        'template' => 'val1 / val2'
        , 'context' => $NUMERIC_SET_DIV
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} / $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 * val2'
        , 'context' => $NUMERIC_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} * $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 * val2'
        , 'context' => {
            'val1' => 'repeat'
            , 'val2' => '5'
        }
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} x $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 % val2'
        , 'context' => $NUMERIC_SET_DIV
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} % $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 + val2'
        , 'context' => $NUMERIC_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} + $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 + val2'
        , 'context' => $STRING_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'}.$c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 - val2'
        , 'context' => $NUMERIC_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} - $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 == val2'
        , 'context' => $COMPARE_NUM_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} == $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 == val2'
        , 'context' => $STRING_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} eq $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 != val2'
        , 'context' => $COMPARE_NUM_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} != $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 != val2'
        , 'context' => $STRING_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} ne $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 <> val2'
        , 'context' => $COMPARE_NUM_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} != $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 > val2'
        , 'context' => $COMPARE_NUM_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} > $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 > val2'
        , 'context' => $STRING_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} gt $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 < val2'
        , 'context' => $COMPARE_NUM_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} < $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 < val2'
        , 'context' => $STRING_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} lt $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 >= val2'
        , 'context' => $COMPARE_NUM_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} >= $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 >= val2'
        , 'context' => $STRING_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} ge $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 <= val2'
        , 'context' => $COMPARE_NUM_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} <= $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 <= val2'
        , 'context' => $STRING_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} le $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 or val2'
        , 'context' => $LOGICAL_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} || $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 and val2'
        , 'context' => $LOGICAL_SET
        , 'control' => sub{
            my $c = shift;
            return( $c->{'val1'} && $c->{'val2'});
        }
    },
################################################################################
    {
        'template' => 'val1 + val2 * val1 - val1 % val2 + val1 / val2'
        , 'context' => $NUMERIC_SET_DIV
        , 'control' => sub{
            my $c = shift;
            my( $val1, $val2 ) = @$c{'val1', 'val2'};
            return( $val1 + $val2 * $val1 - $val1 % $val2 + $val1 / $val2);
        }
    },
################################################################################
    {
        'template' => '(val1 + val2) * val1 - val1 % (val2 + val1) / val2'
        , 'context' => $NUMERIC_SET_DIV
        , 'control' => sub{
            my $c = shift;
            my( $val1, $val2 ) = @$c{'val1', 'val2'};
            return( ($val1 + $val2) * $val1 - $val1 % ($val2 + $val1) / $val2);
        }
    },
################################################################################
    {
        'template' => '((val1 + val2) * (val1 - val2 )) % (val2 + val1) / val2'
        , 'context' => $NUMERIC_SET_DIV
        , 'control' => sub{
            my $c = shift;
            my( $val1, $val2 ) = @$c{'val1', 'val2'};
            return( (($val1 + $val2) * ($val1 - $val2)) % ($val2 + $val1) / $val2);
        }
    },
];

foreach my $sample (@$samples)
{
    $exp = new DTL::Fast::Expression($sample->{'template'});

    if( ref $sample->{'context'} eq 'HASH' )
    {
        $sample->{'context'} = [$sample->{'context'}];
    }

    subtest $sample->{'template'} => sub
    {
    
        foreach my $context (@{$sample->{'context'}})
        {
            my @context = ();
            
            foreach my $key (keys %$context)
            {
                push @context, sprintf( '%s = %s', $key // 'undef', $context->{$key} // 'undef');
            }
            my $title = '';
            if( scalar @context )
            {
                $title = join('; ', @context);
            }

            my $result;
            eval{ $result = $exp->render(new DTL::Fast::Context($context)) };
            
            if ( $@ )
            {
                print STDERR $@;   
            }
            else
            {
                is( 
                    $result
                    , $sample->{'control'}->($context)
                    , $title
                );
            }
        }
    }
}

#use Data::Dumper;print Dumper($exp);

done_testing();