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