| File: | t/04-opt2h2o.t |
| Coverage: | 100.0% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | 1 1 1 | 3208 2 26 | use strict; | ||||
| 2 | 1 1 1 | 4 1 37 | use warnings; | ||||
| 3 | |||||||
| 4 | 1 1 1 | 403 75934 6 | use Test::More q//; | ||||
| 5 | 1 1 1 | 480 2454 2 | use Test::Exception q//; | ||||
| 6 | |||||||
| 7 | 1 1 1 | 652 9368 2 | use Getopt::Long qw/GetOptionsFromArray/; | ||||
| 8 | 1 1 1 | 406 2 1479 | use Util::H2O::More qw/h2o opt2h2o Getopt2h2o/; | ||||
| 9 | |||||||
| 10 | 1 | 70071 | my @getopts = qw/option1=s option2=i option3! option4=s@/; | ||||
| 11 | 1 | 3 | my $o = h2o {}, opt2h2o @getopts; | ||||
| 12 | |||||||
| 13 | 1 | 132 | my @ARGV = qw/--option1 foo --option2 12 --option3 --option4 bar --option4 baz/; | ||||
| 14 | 1 | 3 | GetOptionsFromArray( \@ARGV, $o, @getopts ); | ||||
| 15 | |||||||
| 16 | 1 | 1075 | note q{opt2h2o ...}; | ||||
| 17 | 1 | 516 | is $o->option1, q{foo}, q{'--option1 STRING' exists as expected}; | ||||
| 18 | 1 | 267 | is $o->option2, 12, q{'--option2 NUMBER' exists as expected}; | ||||
| 19 | 1 | 233 | is $o->option3, 1, q{'--option3' exists as expected}; | ||||
| 20 | 1 | 232 | is_deeply $o->option4, [qw/bar baz/], q{'--option4 bar --option4 baz' exists as expected}; | ||||
| 21 | |||||||
| 22 | 1 | 488 | @ARGV = qw/--option1 foo --option2 12 --option3 --option4 bar --option4 baz/; | ||||
| 23 | 1 | 3 | $o = Getopt2h2o \@ARGV, {}, qw/option1=s option2=i option3! option4=s@/; | ||||
| 24 | |||||||
| 25 | 1 | 70 | is $o->option1, q{foo}, q{Getopt2h2os: '--option1 STRING' exists as expected}; | ||||
| 26 | 1 | 238 | is $o->option2, 12, q{Getopt2h2os: '--option2 NUMBER' exists as expected}; | ||||
| 27 | 1 | 232 | is $o->option3, 1, q{Getopt2h2os: '--option3' exists as expected}; | ||||
| 28 | 1 | 234 | is_deeply $o->option4, [qw/bar baz/], q{H2oGetopt: '--option4 bar --option4 baz' exists as expected}; | ||||
| 29 | |||||||
| 30 | 1 | 466 | @ARGV = qw/--option1 foo --option2 12 --no-option3 --option4 bar --option4 baz/; | ||||
| 31 | 1 | 3 | $o = Getopt2h2o \@ARGV, {}, qw/option1=s option2=i option3! option4=s@/; | ||||
| 32 | |||||||
| 33 | 1 | 63 | is $o->option1, q{foo}, q{Getopt2h2os: '--option1 STRING' exists as expected}; | ||||
| 34 | 1 | 242 | is $o->option2, 12, q{Getopt2h2os: '--option2 NUMBER' exists as expected}; | ||||
| 35 | 1 | 266 | is $o->option3, 0, q{Getopt2h2os: '--no-option3' (defined with 'option3!') works as expected}; | ||||
| 36 | 1 | 232 | is_deeply $o->option4, [qw/bar baz/], q{H2oGetopt: '--option4 bar --option4 baz' exists as expected}; | ||||
| 37 | |||||||
| 38 | # testing "-autoundef" option | ||||||
| 39 | |||||||
| 40 | 1 | 459 | @ARGV = qw/--option1 foo --option2 12 --option3 --option4 bar --option4 baz/; | ||||
| 41 | 1 | 4 | $o = Getopt2h2o -autoundef, \@ARGV, {}, qw/option1=s option2=i option3! option4=s@/; | ||||
| 42 | |||||||
| 43 | 1 | 65 | is $o->option1, q{foo}, q{Getopt2h2os: '--option1 STRING' exists as expected}; | ||||
| 44 | 1 | 236 | is $o->option2, 12, q{Getopt2h2os: '--option2 NUMBER' exists as expected}; | ||||
| 45 | 1 | 232 | is $o->option3, 1, q{Getopt2h2os: '--option3' exists as expected}; | ||||
| 46 | 1 | 231 | is_deeply $o->option4, [qw/bar baz/], q{H2oGetopt: '--option4 bar --option4 baz' exists as expected}; | ||||
| 47 | 1 | 453 | is $o->doesntexit, undef, q{undefined options return undef with '-autoundef'}; | ||||
| 48 | |||||||
| 49 | # "-autoundef" must allow reads of missing options but refuse writes. | ||||||
| 50 | 1 1 | 304 29 | dies_ok { $o->doesntexit(q{value}) } q{Getopt2h2o '-autoundef' refuses to set a non-existing option}; | ||||
| 51 | |||||||
| 52 | # An undefined defaults HASH is equivalent to an empty defaults HASH. | ||||||
| 53 | 1 | 217 | @ARGV = qw/--option1 defaultless/; | ||||
| 54 | 1 | 5 | $o = Getopt2h2o \@ARGV, undef, qw/option1=s/; | ||||
| 55 | 1 | 70 | is $o->option1, q{defaultless}, q{Getopt2h2o supplies an empty defaults HASH when defaults is undef}; | ||||
| 56 | |||||||
| 57 | # Bad first arguments are rejected by Getopt::Long rather than being | ||||||
| 58 | # accidentally interpreted as the "-autoundef" control option. These | ||||||
| 59 | # exercise the remaining short-circuit paths in the option test. | ||||||
| 60 | 1 1 | 236 24 | dies_ok { Getopt2h2o() } q{Getopt2h2o without an ARGV array reference dies}; | ||||
| 61 | 1 1 | 325 24 | dies_ok { Getopt2h2o 0, {} } q{Getopt2h2o with a false non-ARRAY first argument dies}; | ||||
| 62 | 1 1 | 334 26 | dies_ok { Getopt2h2o q{not-an-argv-ref}, {} } q{Getopt2h2o does not mistake an arbitrary string for '-autoundef'}; | ||||
| 63 | |||||||
| 64 | 1 | 315 | done_testing; | ||||