view release on metacpan or  search on metacpan

t/descriptive.t  view on Meta::CPAN

# test constraints:
# (look at P::V for names, too)
# required => 1
# depends => [...]
# precludes => [...]
# sugar for only_one_of and all_or_none

sub is_opt {
  my ($argv, $specs, $expect, $desc) = @_;
  local @ARGV = @$argv;
  local $Test::Builder::Level = $Test::Builder::Level + 1;
  my $ok = eval {
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my ($opt, $usage) = describe_options(
      "test %o",
      @$specs,
    );
    is_deeply(
      $opt,
      $expect,

t/shortcircuit.t  view on Meta::CPAN

}

like(
  exception { describe_options( _args() ) },
  qr/required/,
  'no req: error',
);

like(
  warning {
    local @ARGV = @reqs;
    describe_options( _args( default => 1 ) );
  },
  qr/'default' does not make sense for shortcircuit/,
  'shortcircuit + default'
);

SKIP: {
  my $opt;

  is(
    exception {
      local @ARGV = @reqs;
      ( $opt ) = describe_options( _args() );
    },
    undef,
    'req: no error'
  ) or skip( 'no object due to failure', 1 );

  ok( defined $opt->req1 && $opt->req1 == 1, 'req: req1 specified' );
}

SKIP: {
  my $opt;

  is(
    exception {
      local @ARGV = qw[ --help ];
      ( $opt ) = describe_options( _args() );
    },
    undef,
    'help: no error'
  ) or skip( 'no object due to failure', 2 );

  is( $opt->help,          1, 'help: help flag' );
  is( scalar keys %{$opt}, 1, 'help: only help' );
}

SKIP: {
  my ( $w, $opt );

  is(
    exception {
      local @ARGV = qw[ --help ];
      ( $opt ) = describe_options( _args( @reqs ) );
    },
    undef,
    'help + req: no error'
  ) or skip( 'no object due to failure', 2 );

  is( $opt->help,          1, 'help + req: help flag' );
  is( scalar keys %{$opt}, 1, 'help + req: only help' );
}