Getopt-Guided

 view release on metacpan or  search on metacpan

t/extensions/list.t  view on Meta::CPAN

  qw( is imported_ok like ok plan subtest warning );
BEGIN { MODULE->import( 'getopts' ) }

plan 5;

imported_ok 'getopts';

subtest 'List option specified but not used' => sub {
  plan tests => 3;

  local @ARGV = qw( -a foo -b );
  ok getopts( 'a:I,b', my %got_opts ), 'Succeeded';
  is \%got_opts, { a => 'foo', b => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'List option repeated once' => sub {
  plan tests => 3;

  local @ARGV = qw( -I lib -a foo -c );
  ok getopts( 'a:I,c', my %got_opts ), 'Succeeded';
  is \%got_opts, { I => [ 'lib' ], a => 'foo', c => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'List option repeated 2 times' => sub {
  plan tests => 3;

  local @ARGV = qw( -b -I lib -a foo -I local/lib/perl5 );
  ok getopts( 'I,a:b', my %got_opts ), 'Succeeded';
  is \%got_opts, { I => [ 'lib', 'local/lib/perl5' ], a => 'foo', b => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'List option repeated 2 times; 2nd option-argument is undefined' => sub {
  plan tests => 4;

  local @ARGV = qw( -I lib -a foo -c -I );
  my %got_opts;
  like warning { ok !getopts( 'a:cI,', %got_opts ), 'Failed' }, qr/option requires an argument -- I/, 'Check warning';
  is \%got_opts, {}, '%got_opts is empty';
  is \@ARGV, [ qw( -I lib -a foo -c -I ) ], '@ARGV restored'
}

t/extensions/map.t  view on Meta::CPAN

  [ '=',        { '' => '' },      'neither key nor value' ],
  [ 'os=',      { os => '' },      'key only' ],
  [ '=linux',   { '' => 'linux' }, 'value only' ],
  [ 'os=linux', { os => 'linux' }, 'key and value' ]
  )
{
  subtest sprintf( 'Map option repeated once (%s)', $_->[ -1 ] ) => sub {
    plan tests => 3;
    my ( $value, $map ) = @_;

    local @ARGV = ( '-d', $value, qw(-a foo -c ) );
    ok getopts( 'a:d=c', my %got_opts ), 'Succeeded';
    is \%got_opts, { d => $map, a => 'foo', c => 1 }, 'Options properly set';
    is @ARGV, 0, '@ARGV is empty'
    },
    @$_
}

subtest 'Map option repeated 2 times' => sub {
  plan tests => 3;

  # -dos=linux is same as -d os=linux
  local @ARGV = qw( -b -dos=linux -a foo -d vendor=redhat );
  ok getopts( 'd=a:b', my %got_opts ), 'Succeeded';
  is \%got_opts, { d => { os => 'linux', vendor => 'redhat' }, a => 'foo', b => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Map option repeated 3 times; overwrite' => sub {
  plan tests => 3;

  # -dvendor=redhat is same as -d vendor=redhat
  local @ARGV = qw( -b -dos=linux -a foo -dvendor=redhat -d os=windows );
  ok getopts( 'd=a:b', my %got_opts ), 'Succeeded';
  is \%got_opts, { d => { os => 'windows', vendor => 'redhat' }, a => 'foo', b => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Map option repeated 2 times; 2nd option-argument is invalid' => sub {
  plan tests => 4;

  local @ARGV = qw( -d os=linux -a foo -c -d vendor );
  my %got_opts;
  like warning { ok !getopts( 'a:cd=', %got_opts ), 'Failed' }, qr/option requires a key=value argument -- d/,
    'Check warning';
  is \%got_opts, {}, '%got_opts is empty';
  is \@ARGV, [ qw( -d os=linux -a foo -c -d vendor ) ], '@ARGV restored'
}

t/extensions/others.t  view on Meta::CPAN

  qw( is imported_ok ok plan subtest );
BEGIN { MODULE->import( 'getopts' ) }

plan 3;

imported_ok 'getopts';

subtest 'Logically negate flag value; exclamation mark ("!") flag indicator' => sub {
  plan tests => 3;

  local @ARGV = qw( -b -a foo -v -b -vv -c );
  ok getopts( 'a:b!cv', my %got_opts ), 'Succeeded';
  is \%got_opts, { a => 'foo', b => '', c => 1, v => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Increment flag value; plus ("+") flag indicator' => sub {
  plan tests => 3;

  local @ARGV = qw( -b -a foo -v -b -vv -c );
  ok getopts( 'a:bcv+', my %got_opts ), 'Succeeded';
  is \%got_opts, { a => 'foo', b => 1, c => 1, v => 3 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
}

t/load.t  view on Meta::CPAN

  qw( is note ok plan );
plan 5;
use Test2::Plugin::DieOnFail;

use Config qw( %Config );

my $main_module;
my $main_module_version;
{
  local @INC  = @INC;
  local @ARGV = qw( DISTNAME NAME VERSION );
  ok scalar( ( my $distname, $main_module, $main_module_version ) = @{ require './Makefile.PL' } ), ## no critic ( RequireBarewordIncludes )
    "Load 'Makefile.PL' as a module";
  is $distname, 'Getopt-Guided', 'Check dist name';
  is $main_module, 'Getopt::Guided', 'Check main module name'
}

ok eval "require $main_module", "Load main module '$main_module'"; ## no critic ( RequireCheckingReturnValueOfEval )
is $main_module_version, $main_module->VERSION, 'Check main module version';
note "Testing $main_module $main_module_version";

t/readopts.t  view on Meta::CPAN

  $module = 'Getopt::Guided';
  use_ok $module, qw( readopts ) or BAIL_OUT "Cannot load module '$module'!"
}

local $ENV{ XDG_CONFIG_HOME } = catdir( dirname( __FILE__ ), 'data', '.config' );

subtest 'rcfile is missing' => sub {
  plan tests => 2;

  local $0    = 'missing';
  local @ARGV = ();
  lives_ok { readopts( @ARGV ) } 'No exception';
  is_deeply \@ARGV, [], 'No defaults added';
};

subtest 'rcfile exists and is fine' => sub {
  plan tests => 4;

  local $0    = 'fine';
  local @ARGV = ();
  lives_ok { readopts( @ARGV ) } 'No exception';
  is_deeply \@ARGV, [ '-a', ' foo  bar	', '-b' ], 'Defaults added'; ## no critic ( ProhibitHardTabs )

  # Alternative test that puts the focus on the return value of readopts()
  local @ARGV = ();
  # https://stackoverflow.com/questions/9307137/list-assignment-in-scalar-context
  ok not( () = readopts( @ARGV ) ), 'No exception'; ## no critic ( RequireTestLabels )
  is_deeply \@ARGV, [ '-a', ' foo  bar	', '-b' ], 'Defaults added' ## no critic ( ProhibitHardTabs )
};

subtest 'rcfile exists and is broken' => sub {
  plan tests => 1;

  local $0    = 'broken';
  local @ARGV = ();
  like exception { readopts( @ARGV ) }, qr/\AFile '.*$0rc' contains the invalid line 'ba foo'/, 'Grouping is not allowed'
}

t/standard.t  view on Meta::CPAN

use Test::Warn qw( warning_like );

my $module;

BEGIN {
  if ( defined $ENV{ UUT } and ( $module = $ENV{ UUT } ) eq 'Getopt::Std' ) {
    require_ok $module or BAIL_OUT "Cannot load module '$module'!";
    # Wrap Getopt::Std::getopts() to patch its PROTO section
    *getopts = sub ( $\%;\@ ) {
      my ( $spec, $opts, $argv ) = @_;
      local @ARGV = @$argv if defined $argv;
      Getopt::Std::getopts( $spec, $opts )
    }
  } else {
    $module = 'Getopt::Guided';
    use_ok $module, qw( getopts ) or BAIL_OUT "Cannot load module '$module'!"
  }
}

subtest 'Flag' => sub {
  plan tests => 3;

  local @ARGV = qw( -b );
  ok getopts( 'b', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { b => 1 }, 'Flag has value 1';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Common option: Option and option-argument are separate arguments' => sub {
  plan tests => 3;

  local @ARGV = qw( -a foo );
  ok getopts( 'a:', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'foo' }, 'Option has option-argument';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Common option: Option and option-argument are part of same argument string' => sub {
  plan tests => 3;

  local @ARGV = qw( -afoo );
  ok getopts( 'a:', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'foo' }, 'Option has option-argument';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Empty @ARGV' => sub {
  plan tests => 3;

  local @ARGV = ();
  ok getopts( 'a:b', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, {}, '%got_opts is empty';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Common option: Use unshift to set default' => sub {
  plan tests => 3;

  local @ARGV = qw( -b );
  # Simulate default for option with option-argument
  unshift @ARGV, ( -a => 'foo' );
  ok getopts( 'a:b', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'foo', b => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Grouping: Flag followed by common option (separate arguments)' => sub {
  plan tests => 3;

  local @ARGV = qw( -ba foo );
  ok getopts( 'a:b', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'foo', b => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Grouping: Flag followed by common option (part of same argument string)' => sub {
  plan tests => 3;

  local @ARGV = qw( -bafoo );
  ok getopts( 'a:b', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'foo', b => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Grouping: Flag followed by common option that slurps flag' => sub {
  plan tests => 3;

  local @ARGV = qw( -cab foo );
  ok getopts( 'a:bc', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'b', c => 1 }, 'Options properly set';
  is_deeply \@ARGV, [ qw( foo ) ], '@ARGV restored'
};

subtest 'End of options delimiter' => sub {
  plan tests => 3;

  local @ARGV = qw( -ba foo -c -- -d bar );
  ok getopts( 'a:bc', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'foo', b => 1, c => 1 }, 'Options properly set';
  is_deeply \@ARGV, [ qw( -d bar ) ], 'Options removed from @ARGV'
};

subtest 'End of options delimiter is treated as an option-argument' => sub {
  plan tests => 3;

  local @ARGV = qw( -ba foo -d -- -c );
  ok getopts( 'a:bcd:', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'foo', b => 1, c => 1, d => '--' }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Unknown option' => sub {
  plan tests => 4;

  local @ARGV = qw( -b -d bar -a foo );
  my %got_opts;
  if ( $module eq 'Getopt::Std' ) {
    warning_like { ok !getopts( 'a:b', %got_opts ), 'Failed' } qr/\AUnknown option: d/, 'Check warning';
    is_deeply \%got_opts, { b => 1 }, 'Options set partially';
    is_deeply \@ARGV, [ qw( bar -a foo ) ], '@ARGV processed partially'
  } else {
    warning_like { ok !getopts( 'a:b', %got_opts ), 'Failed' } qr/illegal option -- d/, 'Check warning';
    is_deeply \%got_opts, {}, '%got_opts is empty';
    is_deeply \@ARGV, [ qw( -b -d bar -a foo ) ], '@ARGV restored'
  }
};

subtest 'Unknown option: Use unshift to set default' => sub {
  plan tests => 4;

  local @ARGV = qw( -b -d bar );
  # Simulate default for option with option-argument
  unshift @ARGV, ( -a => 'foo' );
  my %got_opts;
  if ( $module eq 'Getopt::Std' ) {
    warning_like { ok !getopts( 'a:b', %got_opts ), 'Failed' } qr/Unknown option: d/, 'Check warning';
    is_deeply \%got_opts, { a => 'foo', b => 1 }, 'Options set partially';
    is_deeply \@ARGV, [ qw( bar ) ], '@ARGV partially processed'
  } else {
    warning_like { ok !getopts( 'a:b', %got_opts ), 'Failed' } qr/illegal option -- d/, 'Check warning';
    is_deeply \%got_opts, {}, '%got_opts is empty';
    is_deeply \@ARGV, [ qw( -a foo -b -d bar ) ], '@ARGV restored'
  }
};

subtest 'Trailing common option with missing option-argument' => sub {
  local @ARGV = qw( -b -a foo -c );
  my %got_opts;
  if ( $module eq 'Getopt::Std' ) {
    plan tests => 3;

    # https://github.com/Perl/perl5/issues/23906
    # Getopt::Std questionable undefined value bahaviour
    ok !getopts( 'a:bc:', %got_opts ), 'Failed';
    is_deeply \%got_opts, { a => 'foo', b => 1, c => undef }, 'Options set';
    is @ARGV, 0, '@ARGV is empty'
  } else {
    plan tests => 4;

    warning_like { ok !getopts( 'a:bc:', %got_opts ), 'Failed' } qr/option requires an argument -- c/, 'Check warning';
    is_deeply \%got_opts, {}, '%got_opts is empty';
    is_deeply \@ARGV, [ qw( -b -a foo -c ) ], '@ARGV restored'
  }
};

subtest 'Common option with undefined option-argument' => sub {
  local @ARGV = ( '-b', '-a', undef, '-c' );
  my %got_opts;
  if ( $module eq 'Getopt::Std' ) {
    plan tests => 3;

    ok getopts( 'a:bc', %got_opts ), 'Succeeded';
    is_deeply \%got_opts, { a => undef, b => 1, c => 1 }, 'Options set';
    is @ARGV, 0, '@ARGV is empty'
  } else {
    plan tests => 4;

    warning_like { ok !getopts( 'a:bc', %got_opts ), 'Failed' } qr/option requires an argument -- a/, 'Check warning';
    is_deeply \%got_opts, {}, '%got_opts is empty';
    is_deeply \@ARGV, [ ( '-b', '-a', undef, '-c' ) ], '@ARGV restored'
  }
};

subtest 'Non-option-argument stops option parsing' => sub {
  plan tests => 3;

  local @ARGV = qw( -b -a foo bar -c );
  ok getopts( 'a:bc', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'foo', b => 1 }, 'Options properly set';
  is_deeply \@ARGV, [ qw( bar -c ) ], 'Options removed from @ARGV'
};

subtest 'The option delimiter is a non-option-argument that stops option parsing' => sub {
  plan tests => 3;

  local @ARGV = qw( -b - a foo bar -c );
  ok getopts( 'a:bc', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { b => 1 }, 'Options properly set';
  is_deeply \@ARGV, [ qw( - a foo bar -c ) ], 'Options removed from @ARGV'
};

subtest 'Overwrite option-argument' => sub {
  plan tests => 3;

  local @ARGV = qw( -a foo -b -a bar -c );
  ok getopts( 'a:bc', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => 'bar', b => 1, c => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
};

subtest 'Slurp option' => sub {
  plan tests => 3;

  local @ARGV = qw( -a -b -c );
  ok getopts( 'a:bc', my %got_opts ), 'Succeeded';
  is_deeply \%got_opts, { a => '-b', c => 1 }, 'Options properly set';
  is @ARGV, 0, '@ARGV is empty'
}

t/synopsis.t  view on Meta::CPAN

  qw( is imported_ok ok plan subtest );
BEGIN { MODULE->import( 'getopts' ) }

plan 4;

imported_ok 'getopts';

subtest 'POD synopsis (getopts processing)' => sub {
  plan tests => 3;

  local @ARGV = qw( -e ek1=ev1 -d dv1 -c -va av1 -ddv2 -a av2 -d -- -eek2=ev2 -vv v1 v2 );
  ok getopts( 'a:e=bcd,v+', my %got_opts ), 'Succeeded';
  is \%got_opts, { a => 'av2', c => 1, d => [ qw( dv1 dv2 -- ) ], e => { ek1 => 'ev1', ek2 => 'ev2' }, v => 3 },
    'Options properly set';
  is \@ARGV, [ qw( v1 v2 ) ], 'Options removed from @ARGV'
};

subtest 'POD synopsis (getopts three-parameter form processing with parenthesis)' => sub {
  plan tests => 3;

  # On purpose don't work with a localized @ARGV
  my @argv = qw( -e ek1=ev1 -d dv1 -c -va av1 -ddv2 -a av2 -d -- -eek2=ev2 -vv v1 v2 );
  ok getopts( 'a:e=bcd,v+', my %got_opts, @argv ), 'Succeeded';
  is \%got_opts, { a => 'av2', c => 1, d => [ qw( dv1 dv2 -- ) ], e => { ek1 => 'ev1', ek2 => 'ev2' }, v => 3 },
    'Options properly set';
  is \@argv, [ qw( v1 v2 ) ], 'Options removed from @argv'
};

subtest 'POD synopsis (getopts three-parameter form processing without parenthesis)' => sub {
  plan tests => 3;

  # On purpose don't work with a localized @ARGV
  my @argv = qw( -e ek1=ev1 -d dv1 -c -va av1 -ddv2 -a av2 -d -- -eek2=ev2 -vv v1 v2 );
  no warnings 'parenthesis'; ## no critic ( ProhibitNoWarnings )
  my $return_value = getopts 'a:e=bcd,v+', my %got_opts, @argv;
  ok $return_value, 'Succeeded';
  is \%got_opts, { a => 'av2', c => 1, d => [ qw( dv1 dv2 -- ) ], e => { ek1 => 'ev1', ek2 => 'ev2' }, v => 3 },
    'Options properly set';
  is \@argv, [ qw( v1 v2 ) ], 'Options removed from @argv'
}

t/validation.t  view on Meta::CPAN

  qw( dies is imported_ok like ok plan subtest );
BEGIN { MODULE->import( 'getopts' ) }

plan 3;

imported_ok 'getopts';

subtest 'Validate $spec parameter' => sub {
  plan tests => 6;

  local @ARGV = ();
  my %opts;
  like dies { getopts undef, %opts }, qr/\A\$spec parameter isn't a non-empty string of alphanumeric/,
    'Undefined value is not allowed';
  like dies { getopts '', %opts }, qr/\A\$spec parameter isn't a non-empty string of alphanumeric/,
    'Empty value is not allowed';
  like dies { getopts 'a:-b', %opts }, qr/\A\$spec parameter isn't a non-empty string of alphanumeric/,
    "'-' character is not allowed";
  like dies { getopts ':a:b', %opts }, qr/\A\$spec parameter isn't a non-empty string of alphanumeric/,
    "Leading ':' character is not allowed";
  like dies { getopts 'aba:', %opts }, qr/\A\$spec parameter contains option 'a' multiple times/,
    'Same option character is not allowed';
  ok getopts( 'a:b', %opts ), 'Succeeded'
};

subtest 'Validate $opts parameter' => sub {
  plan tests => 1;

  local @ARGV = ();
  my %opts = ( a => 'foo' );
  like dies { getopts 'a:b', %opts }, qr/\A\%\$opts parameter isn't an empty hash/, 'Result %opts hash has to be empty'
}