# 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 parse
+d 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[<undef>]; }

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 "cat
+ch" block
   #     prints only "Died" after the colon.
   try
   {
      # Use incremented value type to count number of times options ma
+tched.
      GetOptions( 'option|o+' => \$option )
         or die $!;
      $show_progress and warn qq[option set: $option];
   }
   catch
   {
      warn qq[Option parsing failed of @arg: $_];
   }
   ;

   return $option;
}
[download]