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

BEGIN {

    push @good_specs, {
        label => "negation test",
        spec  => [
            Switch("test|t")->default(1),
            Counter("ver-bose|v")->default(2),
            Param("file|f")->default("foo.txt"),
            List("lib|l")->default(qw( /var /tmp )),
            Keypair("def|d")->default({os => 'linux', arch => 'i386'}),
        ],
        cases => [
            {
                argv    => [ qw( --no-test --no-ver-bose --no-file --no-lib
                                 --no-def ) ],
                result  => {
                    "test" => 0,
                    "ver-bose" => 0,
                    "file" => "",
                    "lib" => [],
                    "def" => {},
                },
                desc    => "long-form negate everything"
            },
            {
                argv    => [ qw( no-test no-ver-bose no-file no-lib
                                 no-def ) ],
                result  => {
                    "test" => 0,
                    "ver-bose" => 0,
                    "file" => "",
                    "lib" => [],
                    "def" => {},
                },
                desc    => "bareword-form negate everything"
            },
            {
                argv    => [ qw( no-lib=/var --no-def=os ) ],
                result  => {
                    "test" => 1,
                    "ver-bose" => 2,
                    "file" => "foo.txt",
                    "lib" => [qw( /tmp )],
                    "def" => { arch => "i386" },
                },
                desc    => "negate list item and keypair key"
            },
            {
                argv    => [ qw( no-test no-ver-bose no-file
                                 no-lib=/var --no-def=os
                                 --test --ver-bose --file boo.txt
                                 --lib /home --def flag=O2) ],
                result  => {
                    "test" => 1,
                    "ver-bose" => 1,
                    "file" => "boo.txt",
                    "lib" => [qw( /tmp /home )],
                    "def" => { arch => "i386", flag => "O2" },
                },
                desc    => "negate followed by new options"
            },
            {
                argv    => [ qw( no-test=1  ) ],
                exception   => "Getopt::Lucid::Exception::ARGV",
                error_msg => _switch_value("test","1"),
                desc    => "negative switch can't take value"
            },
            {
                argv    => [ qw( no-ver-bose=1  ) ],
                exception   => "Getopt::Lucid::Exception::ARGV",
                error_msg => _counter_value("ver-bose","1"),
                desc    => "negative counter can't take value"
            },
            {
                argv    => [ qw( no-file=foo.txt  ) ],
                exception   => "Getopt::Lucid::Exception::ARGV",
                error_msg => _param_neg_value("file","foo.txt"),
                desc    => "negative param can't take value"
            },
        ]
    };


    push @good_specs, {
        label => "negation w/ validation",
        spec  => [
            Param( "mode|m", qr/test|live/ )
        ],
        cases => [
            {
                argv    => [ qw() ],
                result  => {
                    "mode" => undef,
                },
                desc    => "no param validates"
            },
            {
                argv    => [ qw( --no-mode ) ],
                result  => {
                    "mode" => '',
                },
                desc    => "negated param validates"
            },
        ]
    };


    push @good_specs, {
        label => "required/prereq",
        spec  => [
            Switch("test"),
            Param("input")->needs("output"),
            Param("output"),
        ],
        cases => [
            {
                argv    => [ qw( --test --no-test ) ],
                exception   => "Getopt::Lucid::Exception::ARGV",
                required => ['test'],
                error_msg => _required("test"),
                desc    => "missing requirement after negation"
            },
            {
                argv    => [ qw( --test --input in.txt
                                 --output out.txt --no-output ) ],
                exception   => "Getopt::Lucid::Exception::ARGV",
                required => ['test'],
                error_msg => _prereq_missing("input","output",),
                desc    => "missing prereq after negation"
            },
        ],
    };

} #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) };
    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);
            @cmd_line = @{$case->{argv}};
            my %opts;
            my $valid_args = $case->{required}  ? {requires => $case->{required}}
                                                : {};
            try eval { %opts = $gl->getopt->validate($valid_args)->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);
            }
        }
    }
}