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