use strict;
use Test::More;
use Data::Dumper;
use Exception::Class::TryCatch;
use Getopt::Lucid ':all';
use Getopt::Lucid::Exception;
# 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 => "parse another array than \@ARGV",
spec => [
Switch("--verbose"),
Switch("--test"),
Switch("-r"),
],
cases => [
{
argv => [ qw( --verbose -r -- --test ) ],
result => { "verbose" => 1, "test" => 0, "r" => 1 },
after => [ qw( --test ) ],
desc => "stop after two"
},
{
argv => [ qw( -- -r --test ) ],
result => { "verbose" => 0, "test" => 0, "r" => 0 },
after => [ qw(-r --test ) ],
desc => "stop right away"
},
]
};
} #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;
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);
}
}
}
}