(nothing provided)
prefix=-
long_prefix_pattern=--
posix_default
getopt_compat
no_posix_default
no_getopt_compat
####
prefix=-
long_prefix_pattern=--
prefix=-, long_prefix_pattern=--
####
perl5.36 getopt-test-combination.pl > out 2> err
grep '^ok.+input:.+--o' out
####
grep --color=always '^not ok.+input: -o --o.+parsed: [0-9]+.+(long_)?prefix' out | head -n 3
not ok 6 - input: -o --o; parsed: 1; conf: ( prefix=- )
not ok 9 - input: -o --o; parsed: 1; conf: ( long_prefix_pattern=-- )
not ok 30 - input: -o --o; parsed: 1; conf: ( prefix=-, long_prefix_pattern=-- )
...
####
# getopt-test-combination.pl
use v5.32;
use warnings;
use feature q[signatures];
# Intermix debug output with standard output.
$|++;
use Algorithm::Combinatorics qw[ combinations ];
use Getopt::Long;
use List::Util qw[ any ];
use Try::Tiny;
use Test2::V0 qw[ like done_testing ];
my $Getopt_debug = 0;
my $show_progress = 0;
my $indent_2 = q[ ] x 2;
my $indent_4 = q[ ] x 4;
# Keys are split on space to set @ARGV for "GetOptions" sub.
my %expected = (
# Options => [ expected value(s) ].
#
# XXX: Reason for value being an array ref, not a plain scalar:
# The long option with "--" prefix should be always be parsed as valid
# with "long_prefix_pattern=--" configuration option.
#
# Tolerate the long option with "-" prefix as valid IFF that makes
# single letter option with "--" prefix as invalid.
q[-o] => [ 1 ],
q[--o] => [ undef ],
q[-o --o] => [ undef ],
q[-option] => [ undef, 1],
q[--option] => [ 1 ],
q[-o --option] => [ 2 ],
q[-o -option] => [ undef, 2 ],
q[-o -option --option] => [ undef, 3 ]
);
# Option inputs, same as above keys.
my @order = (
q[-o],
q[--o],
q[-o --o],
# Uncomment to test as needed.
#q[-option],
#q[--option],
#q[-o --option],
#q[-o -option],
#q[-o -option --option]
);
# To Iterate over combinations of Getopt::Long configuration options.
my @conf_opt = qw[
prefix=-
long_prefix_pattern=--
posix_default
no_posix_default
getopt_compat
no_getopt_compat
];
my $conf_opt_size = scalar @conf_opt;
for my $k ( 0..$conf_opt_size )
{
for my $conf ( combinations( \@conf_opt, $k ) )
{
run_conf_test( @{ $conf } );
}
}
done_testing();
exit;
sub account_for_undef( $val ) { return $val // q[]; }
sub list_as_string( @list )
{
return
q[( ]
. join( q[, ], map( account_for_undef( $_ ), @list ) )
. q[ )]
;
}
# To match any value in "$need" array ref.
sub match_expected( $val, $need )
{
if ( ! defined $val )
{
return any { ! defined } @{ $need };
}
return any { defined $_ && $val == $_ } @{ $need };
}
sub run_conf_test( @conf )
{
my $conf_str = list_as_string( @conf );
$show_progress and warn qq[> Configuration: $conf_str];
for my $input ( @order )
{
my $need = $expected{ $input };
my $need_str = list_as_string( @{ $need } );
@ARGV = split q[ ], $input;
my $val = parse_option( @conf );
my $test_id = sprintf( qq[input: %s; parsed: %s; conf: %s],
$input,
account_for_undef( $val ),
$conf_str
);
my @test_diag = (
qq[need any: $need_str]
);
my $matched;
like( $val,
sub { $matched = match_expected( $_, $need ); $matched },
$test_id,
@test_diag
);
if ( $show_progress )
{
warn sprintf qq[>> %s%s; %s\n>> %sas expected? %s],
$indent_2, $test_id, list_as_string( @test_diag ),
$indent_4, account_for_undef( $matched )
;
warn qq[\n\n];
}
}
}
sub parse_option( @conf )
{
if ( ! grep { defined } @conf )
{
@conf = ();
}
if ( $Getopt_debug )
{
push @conf, q[debug] ;
}
#warn list_as_string( @conf );
Getopt::Long::Configure( @conf );
# For error message.
my @arg = @ARGV;
my $option;
# XXX: How to get the error message from "GetOptions" sub? The "catch" block
# prints only "Died" after the colon.
try
{
# Use incremented value type to count number of times options matched.
GetOptions( 'option|o+' => \$option )
or die $!;
$show_progress and warn qq[option set: $option];
}
catch
{
warn qq[Option parsing failed of @arg: $_];
}
;
return $option;
}