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;

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

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

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);

BEGIN {

    push @good_specs, {
        label => "mixed format names in spec",
        spec  => [
            Counter("ver-bose|-v"),
            Counter("--test|-t"),
            Counter("-r"),
            Param("f"),
        ],
        cases => [
            {
                argv    => [ qw( ver-bose -v -rtv f=test -r --test -- test ) ],
                result  => {
                    "ver-bose" => 3,
                    "test" => 2,
                    "r" => 2,
                    "f" => "test",
                },
                after   => [qw( test )],
                desc    => "all three types in command line"
            },
            {
                argv    => [ qw( ver-bose -v -rtv f test -r --test -- test ) ],
                result  => {
                    "ver-bose" => 3,
                    "test" => 2,
                    "r" => 2,
                    "f" => "test",
                },
                after   => [qw( test )],
                desc    => "bare param with bare like long-form in spec"
            },
            {
                argv    => [ qw( ver-bose -v -rtv f=test -r test ) ],
                result  => {
                    "ver-bose" => 3,
                    "test" => 1,
                    "r" => 2,
                    "f" => "test",
                },
                after   => [qw( test )],
                desc    => "bareword like long-form in spec passed through"
            },
            {
                argv    => [ qw( -test ) ],
                exception   => "Getopt::Lucid::Exception::ARGV",
                error_msg => _invalid_argument("-e"),
                desc    => "single dash with word"
            },
            {
                argv    => [ qw( --ver-bose ) ],
                exception   => "Getopt::Lucid::Exception::ARGV",
                error_msg => _invalid_argument("--ver-bose"),
                desc    => "long form like bareword in spec"
            },
            {
                argv    => [ qw( --r ) ],
                exception   => "Getopt::Lucid::Exception::ARGV",
                error_msg => _invalid_argument("--r"),
                desc    => "long form like short in spec"
            },
            {
                argv    => [ qw( -f=--test ) ],
                exception   => "Getopt::Lucid::Exception::ARGV",
                error_msg => _invalid_argument("-f"),
                desc    => "shoft form like bare in spec"
            },
        ]
    };


} #BEGIN

for my $t (@good_specs) {
    $num_tests += 1 + 2 * @{$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, {strict => 1}) };
    catch my $err;
    is( $err, undef, "$trial->{label}: spec should validate" );
    SKIP: {
        if ($err) {
            my $num_tests = 2 * @{$trial->{cases}};
            skip "because $trial->{label} spec did not validate", $num_tests;
        }
        for my $case ( @{$trial->{cases}} ) {
            my $gl = Getopt::Lucid->new($trial->{spec}, \@cmd_line, {strict => 1});
            @cmd_line = @{$case->{argv}};
            my %opts;
            try eval { %opts = $gl->getopt->options };
            catch my $err;
            if (defined $case->{exception}) { # expected
                ok( $err && $err->isa( $case->{exception} ),
                    "$trial->{label}: $case->{desc} should throw exception" )
                    or diag why( got => ref($err), expected => $case->{exception});
                is( $err, $case->{error_msg},
                    "$trial->{label}: $case->{desc} error message correct");
            } elsif ($err) { # unexpected
                fail( "$trial->{label}: $case->{desc} threw an exception")
                    or diag "Exception is '$err'";
                pass("$trial->{label}: skipping \@ARGV check");
            } else { # no exception
                is_deeply( \%opts, $case->{result},
                    "$trial->{label}: $case->{desc}" ) or
                    diag why( got => \%opts, expected => $case->{result});
                my $argv_after = $case->{after} || [];
                is_deeply( \@cmd_line, $argv_after,
                    "$trial->{label}: \@cmd_line correct after processing") or
                    diag why( got => \@cmd_line, expected => $argv_after);
            }
        }
    }
}