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