The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use Test::More;
use Data::Dumper;
use Exception::Class::TryCatch;

use Getopt::Lucid ':all';
use Getopt::Lucid::Exception;
use t::ErrorMessages;

# Work around win32 console buffering that can show diags out of order
Test::More->builder->failure_output(*STDOUT) if $ENV{HARNESS_VERBOSE};

sub why {
    my %vars = @_;
    $Data::Dumper::Sortkeys = 1;
    return "\n" . Data::Dumper->Dump([values %vars],[keys %vars]) . "\n";
}

#--------------------------------------------------------------------------#
# Test cases
#--------------------------------------------------------------------------#

my ($num_tests, @good_specs);

    push @good_specs, { 
        label => "test",
        spec  => [
            Switch("test|t")->default(1),
            Counter("verbose|v")->default(2),
            Param("file|f")->valid(qr/[a-z]+/)->default("foo"),
            List("lib|l")->default(qw( /var /tmp ))->valid(qr/[\/\w]+/),
            Keypair("def|d","os|arch",qr/\w+/)->default(
              {os => 'linux', arch => 'i386'}
            ),
        ],
        cases => [
            { 
                desc    => "no args, no config",
                argv    => [  ],
                config => undef, 
                result  => {
                  append => { 
                    "test" => 1, 
                    "verbose" => 2,
                    "file" => "foo",
                    "lib" => [qw( /var /tmp )],
                    "def" => {os => 'linux', arch => 'i386'},
                  },
                  merge => { 
                    "test" => 1, 
                    "verbose" => 2,
                    "file" => "foo",
                    "lib" => [qw( /var /tmp )],
                    "def" => {os => 'linux', arch => 'i386'},
                  },
                  replace => { 
                    "test" => 1, 
                    "verbose" => 2,
                    "file" => "foo",
                    "lib" => [qw( /var /tmp )],
                    "def" => {os => 'linux', arch => 'i386'},
                  },
                },
            },          
            { 
                desc    => "no args, valid config",
                argv    => [  ],
                config => {
                    "verbose" => 1,
                    "file"  => "bar",
                    "lib"   => "/home",
                    "def"   => { os => 'MSWin32' },
                },
                result  => { 
                  append => {
                    "test" => 1, 
                    "verbose" => 3,
                    "file" => "bar",
                    "lib" => [qw( /var /tmp /home )],
                    "def" => { os => 'MSWin32', arch => 'i386'},
                  },
                  merge => {
                    "test" => 1, 
                    "verbose" => 1,
                    "file" => "bar",
                    "lib" => [qw( /home )],
                    "def" => { os => 'MSWin32' },
                  },
                  replace => {
                    "test" => 0, 
                    "verbose" => 1,
                    "file" => "bar",
                    "lib" => [qw( /home )],
                    "def" => { os => 'MSWin32' },
                  },
                },
            },          
            { 
                desc    => "args plus valid config",
                argv    => [ qw/--def arch=amd64 / ],
                config => {
                    "verbose" => 1,
                    "file"  => "bar",
                    "lib"   => "/home",
                    "def"   => { os => 'MSWin32' },
                },
                result  => { 
                  append => {
                    "test" => 1, 
                    "verbose" => 3,
                    "file" => "bar",
                    "lib" => [qw( /var /tmp /home )],
                    "def" => { os => 'MSWin32', arch => 'amd64'},
                  },
                  merge => {
                    "test" => 1, 
                    "verbose" => 1,
                    "file" => "bar",
                    "lib" => [qw( /home )],
                    "def" => { os => 'MSWin32', arch => 'amd64' },
                  },
                  replace => {
                    "test" => 0, 
                    "verbose" => 1,
                    "file" => "bar",
                    "lib" => [qw( /home )],
                    "def" => { os => 'MSWin32', arch => 'amd64' },
                  },
                },
            },          
            { 
                argv    => [ ],
                exception   => "Getopt::Lucid::Exception::Spec",
                config => {
                    "file"  => "123",
                },
                error_msg => _default_invalid("file","123",),
                desc    => "invalid config"
            },
        ]
    };
    
for my $t (@good_specs) {
    $num_tests += 1 + 6 * @{$t->{cases}};
}

plan tests => $num_tests;

#--------------------------------------------------------------------------#
# Test good specs
#--------------------------------------------------------------------------#

my ($trial, @cmd_line);

while ( $trial = shift @good_specs ) {
    try eval { Getopt::Lucid->new($trial->{spec}, \@cmd_line) };
    catch my $err;
    is( $err, undef, "$trial->{label}: spec should validate" );
    SKIP: {    
        if ($err) {
            my $num_tests = 6 * @{$trial->{cases}};
            skip "because $trial->{label} spec did not validate", $num_tests;
        }
        for my $case ( @{$trial->{cases}} ) {
          for my $method ( qw/append merge replace/ ) {
            no strict 'refs';
            my $cmd = $method . "_defaults";
            my $gl = Getopt::Lucid->new($trial->{spec}, \@cmd_line);
            @cmd_line = @{$case->{argv}};
            try eval { 
              $gl->getopt;
              $gl->$cmd( $case->{config} ) if $case->{config};
            };
            catch my $err;
            if (defined $case->{exception}) { # expected
                ok( $err && $err->isa( $case->{exception} ), 
                    "$trial->{label} $method\_defaults\: $case->{desc} should throw exception" )
                    or diag why( got => ref($err), expected => $case->{exception});
                is( $err, $case->{error_msg}, 
                    "$trial->{label} $method\_defaults\: $case->{desc} error message correct");
            } elsif ($err) { # unexpected
                fail( "$trial->{label} $method\_defaults\: $case->{desc} threw an exception")
                    or diag "Exception is '$err'";
                pass("$trial->{label} $method\_defaults\: skipping \@ARGV check");
            } else { # no exception
                my %opts = $gl->options;
                is_deeply( \%opts, $case->{result}{$method}, 
                    "$trial->{label} $method\_defaults\: $case->{desc}" ) or
                    diag why( got => \%opts, expected => $case->{result}{$method});
                my $argv_after = $case->{after} || [];
                is_deeply( \@cmd_line, $argv_after,
                    "$trial->{label} $method\_defaults\: \@cmd_line correct after processing") or
                    diag why( got => \@cmd_line, expected => $argv_after);
            }
          }
        }
    }
}