# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl 1.t'

#########################

use strict;
use Test::More;
no warnings 'uninitialized';

my $tests = &func_tests;
plan tests => scalar @$tests;

BEGIN {    use_ok('Text::Wigwam::Dtree') };
BEGIN { use_ok('Text::Wigwam::Const') };

use Text::Wigwam::Const qw/:all/;

#########################

# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.

my $dtree;

sub do_fail{
    my( $test, $result, $expect, $message ) = @_;
    warn "\n";
    fail( $test->{testid} );
    warn "*** $message ***" if length($message);
    warn ( $test->{perror} ? "Expected run-time error: " : $test->{terror} ? "Expected template error: " : "Expected results: " );
    warn $expect;
    my $out = length($result)
      ? "  Actual results: $result"
      : "Produced a null string value"
    ;
    warn "$out";
}

sub do_pass{
    my( $test ) = @_;
    pass( $test->{testid} );
##    pass( $test->{method}.": ".$test->{testid} );
}

foreach my $test ( @$tests ){
    if( $test->{method} eq 'new' ){
        $dtree = Text::Wigwam::Dtree->new( @{$test->{params}} );
        do_pass($test);
    }
    elsif( $test->{method} eq 'query' ){
        my( $name, $code, $args, $vars, $err ) = $dtree->query( @{$test->{params}} );
        my $got_arg = join( ", " => @{$args||[]} );
        my $got_var = join( ", " => @{$vars||[]} );
        my $exp_var = join( ", " => @{$test->{vars}||[]} );
        my $exp_arg = join( ", " => @{$test->{args}||[]} );

        if( defined $err && length($err) && !exists $test->{error} ){ do_fail( $test, $err, undef, "Unexpected error encountered" ); }
        elsif( length($test->{error}) ){
            if( !length($err) ){ do_fail( $test, undef, $test->{error}, "No error ocurred when expected" ); }
            if( $err =~ /$test->{error}/ ){ do_pass( $test ); }
            else {  do_fail( $test, $err, $test->{error}, "Expected an error" ); }
        }
        elsif( $test->{name} ne $name ){ do_fail( $test, $name, $test->{name}, "Unexpected directive name" ) }
        elsif( $test->{code} ne $code ){ do_fail( $test, $code, $test->{code}, "unexpected code address" ) }
        elsif( $got_arg ne $exp_arg ){ do_fail( $test, $got_arg, $exp_arg, "Unexpected args array" ) }
        elsif( $got_var ne $exp_var ){ do_fail( $test, $got_var, $exp_var, "Unexpected vars array" ); }
        else{ do_pass( $test ); }
    }
    else{
        do_fail( $test, undef, "Test ".$test->{method}." is not implemented!" )
    }
}

sub func_tests{
    return [
# 1
        {
            testid => ' Initialize Dtree',
            method => 'new',
            params => [
                'Text::Wigwam',                # Base
                'Directives',                # Directive tree base
                '',                    # Directive tree root
                [ '', 'sublevel1', 'sublevel2' ],    # Directive tree path
                0,                    # 1 = Cache off
            ],
        },
        {
            testid => ' Root Level Directive',
            method => 'query',
            params => [
                '#top',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::_top',
            args => [ ARRAY, STRING ],
            vars => [ 'var1', 'var2' ],
            code => \&Text::Wigwam::Directives::_top,
        },
        {
            testid => ' Bad Prototype Value Detection',
            method => 'query',
            params => [
                '#bad',
                'Engine::Test',
                0,
            ],
            error => 'non-existent method',
        },
        {
            testid => ' Nested Directive Level 1',
            method => 'query',
            params => [
                '#foo',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel1::_foo',
            args => [ CODE, ANY ],
            vars => [ 'foo_var1', 'foo_var2' ],
            code => \&Text::Wigwam::Directives::sublevel1::_foo,
        },
        {
            testid => ' Nested Directive Level 1',
            method => 'query',
            params => [
                '#bar',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel1::_bar',
            args => [  BLOCK | EXPR , CODE ],
            vars => [ 'bar_var1', 'bar_var2' ],
            code => \&Text::Wigwam::Directives::sublevel1::_bar,
        },
        {
            testid => ' Nested Directive Level 2',
            method => 'query',
            params => [
                '#bazz',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel2::_bazz',
            args => [ BLOCK | EXPR, CODE ],
            vars => [ 'bazz_var1', 'bazz_var2' ],
            code => \&Text::Wigwam::Directives::sublevel2::_bazz,
        },
        {
            testid => ' Nested Directive Level 2',
            method => 'query',
            params => [
                '#quux',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel2::_quux',
            args => [ CODE, ANY ],
            vars => [ 'quux_var1', 'quux_var2' ],
            code => \&Text::Wigwam::Directives::sublevel2::_quux,
        },
        {
            testid => ' Inherent Directive',
            method => 'query',
            params => [
                '#Top',
                'Engine::Test::Inherent_Directives',
                0,
            ],
            name => 'Text::Wigwam::Engine::Test::Inherent_Directives::_Top',
            args => [ VAR, HASH ],
            vars => [ 'varx', 'vary' ],
            code => \&Text::Wigwam::Engine::Test::Inherent_Directives::_Top,
        },
        {
            testid => ' Missing Prototype',
            method => 'query',
            params => [
                '#no_l1_proto',
                'Engine::Test',
                0,
            ],
            error => 'prototype is missing',
        },
        {
            testid => 'Missing Handler',
            method => 'query',
            params => [
                '#no_l1_handler',
                'Engine::Test',
                0,
            ],
            error => 'handler is missing',
        },
        {
            testid => 'Re-Initialize Dtree',
            method => 'new',
            params => [
                'Text::Wigwam',                # Base
                'Directives',                # Directive tree base
                '',                    # Directive tree root
                [ '', 'sublevel2', 'sublevel1' ],    # Directive tree path
                0,                    # 1 = Cache off
            ],
        },
        {
            testid => 'Nested Directive Level 1',
            method => 'query',
            params => [
                '#foo',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel2::_foo',
            args => [ CODE, ANY ],
            vars => [ 'foo_var1', 'foo_var2' ],
            code => \&Text::Wigwam::Directives::sublevel2::_foo,
        },
        {
            testid => 'Nested Directive Level 1',
            method => 'query',
            params => [
                '#bar',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel2::_bar',
            args => [  BLOCK | EXPR , CODE ],
            vars => [ 'bar_var1', 'bar_var2' ],
            code => \&Text::Wigwam::Directives::sublevel2::_bar,
        },
        {
            testid => 'Nested Directive Level 2',
            method => 'query',
            params => [
                '#bazz',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel2::_bazz',
            args => [ BLOCK | EXPR, CODE ],
            vars => [ 'bazz_var1', 'bazz_var2' ],
            code => \&Text::Wigwam::Directives::sublevel2::_bazz,
        },
        {
            testid => 'Inherent Directive',
            method => 'query',
            params => [
                '#Top',
                'Engine::Test::Inherent_Directives',
                0,
            ],
            name => 'Text::Wigwam::Engine::Test::Inherent_Directives::_Top',
            args => [ VAR, HASH ],
            vars => [ 'varx', 'vary' ],
            code => \&Text::Wigwam::Engine::Test::Inherent_Directives::_Top,
        },
        {
            testid => 'Nested Directive Level 2',
            method => 'query',
            params => [
                '#quux',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel2::_quux',
            args => [ CODE, ANY ],
            vars => [ 'quux_var1', 'quux_var2' ],
            code => \&Text::Wigwam::Directives::sublevel2::_quux,
        },
        {
            testid => 'Missing Prototype',
            method => 'query',
            params => [
                '#sublevel1::no_l1_proto',
                'Engine::Test',
                0,
            ],
            error => 'prototype is missing',
        },
        {
            testid => 'Explicit Path',
            method => 'query',
            params => [
                '#sublevel2::no_l1_proto',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel2::_no_l1_proto',
            args => [ ],
            vars => [ ],
            code => \&Text::Wigwam::Directives::sublevel2::_no_l1_proto,
        },
        {
            testid => 'Missing Handler (Explicit)',
            method => 'query',
            params => [
                '#sublevel1::no_l1_handler',
                'Engine::Test',
                0,
            ],
            error => 'handler is missing',
        },
        {
            testid => 'Found Handler',
            method => 'query',
            params => [
                '#no_l1_handler',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::sublevel2::_no_l1_handler',
            args => [ ],
            vars => [ ],
            code => \&Text::Wigwam::Directives::sublevel2::_no_l1_handler,
        },
        {
            testid => 'Re-Initialize Dtree',
            method => 'new',
            params => [
                'Text::Wigwam',                # Base
                'Directives',                # Directive tree base
                '',                    # Directive tree root
                [ 'sublevel2', 'sublevel1' ],    # Directive tree path
                0,                    # 1 = Cache off
            ],
        },
        {
            testid => 'Implied Root Path',
            method => 'query',
            params => [
                '#top',
                'Engine::Test',
                0,
            ],
            name => 'Text::Wigwam::Directives::_top',
            args => [ ARRAY, STRING ],
            vars => [ 'var1', 'var2' ],
            code => \&Text::Wigwam::Directives::_top,
        },
    ]
}

package Text::Wigwam::Directives;
use Text::Wigwam::Const qw/:all/;

sub _proto_top { [ ARRAY, STRING ], [ 'var1', 'var2' ] }
sub _top { }

sub _proto_bad { [ $_[0]->xSTRING ] }
sub _bad { }

package Text::Wigwam::Directives::sublevel1;
use Text::Wigwam::Const qw/:all/;

sub _proto_foo { [ CODE, ANY ], [ 'foo_var1', 'foo_var2' ] }
sub _foo { }

sub _proto_bar { [ BLOCK | EXPR , CODE ], [ 'bar_var1', 'bar_var2' ] }
sub _bar { }

sub _no_l1_proto { }

sub _proto_no_l1_handler { }

package Text::Wigwam::Directives::sublevel2;
use Text::Wigwam::Const qw/:all/;

sub _proto_quux { [ CODE, ANY ], [ 'quux_var1', 'quux_var2' ] }
sub _quux { }

sub _proto_bazz { [ BLOCK | EXPR , CODE ], [ 'bazz_var1', 'bazz_var2' ] }
sub _bazz { }

sub _proto_foo { [ CODE, ANY ], [ 'foo_var1', 'foo_var2' ] }
sub _foo { }

sub _proto_bar { [ BLOCK | EXPR , CODE ], [ 'bar_var1', 'bar_var2' ] }
sub _bar { }

sub _proto_no_l1_proto { }
sub _no_l1_proto { }

sub _proto_no_l1_handler { }
sub _no_l1_handler { }

package Text::Wigwam::Engine::Test::Inherent_Directives;
use Text::Wigwam::Const qw/:all/;

sub _proto_Top { [ VAR, HASH ], [ 'varx', 'vary' ] }
sub _Top { }
1;