#!/usr/bin/perl
use warnings;
use strict;
use Test::More no_plan =>;
use Getopt::Base;
# sanity-check check
{
eval {
Getopt::Base->new(
positional => [qw(input)],
options => [],
);
};
like($@, qr/positional 'input' is not an option/);
}
########################################################################
# empty option set, '--' termination
{
my $go = Getopt::Base->new();
ok($go);
{
my @arg = (1..3);
my $o = $go->process(\@arg);
ok($o);
is_deeply(\@arg, [1..3], 'no options');
}
{
my @arg = ('--', '--foo');
$go->process(\@arg);
is_deeply(\@arg, ['--foo'], '--');
}
{
my @arg = (7, '--', '--foo');
$go->process(\@arg);
is_deeply(\@arg, [7, '--foo'], '--');
}
}
########################################################################
# simple setup, positional support
{
my $go = Getopt::Base->new(
positional => [qw(input)],
options => [
input => {
type => 'string',
},
],
);
foreach my $set (
['--input', 'foo', 'bar'],
['foo', 'bar'],
['bar', '--input', 'foo'],
['foo', '--', 'bar'],
) {
my @arg = @$set;
my $o = $go->process(\@arg);
is($o->input, 'foo', 'got --input');
is_deeply(\@arg, ['bar']);
}
}
########################################################################
# more with positionals
{
my $go = Getopt::Base->new(
positional => [qw(input output)],
options => [
input => { type => 'string', },
output => { type => 'string', },
],
);
{
my @args = qw(foo bar);
my $o = $go->process(\@args);
is($o->input, 'foo');
is($o->output, 'bar');
is(scalar @args, 0);
}
{
my @args = qw(foo);
my $o = $go->process(\@args);
is($o->input, 'foo');
ok(! exists($o->{output}), 'no output key');
is($o->output, undef);
is(scalar @args, 0);
}
}
########################################################################
# aliases, shortening
{
my $go = Getopt::Base->new(
positional => [qw(input)],
options => [
input => {
aliases => ['something_something', 'extra_sausages'],
short => ['q', 'r', 's'],
type => 'string',
},
],
);
foreach my $try (
[qw(--input foo 42)],
[qw(--in foo 42)],
[qw(42 --something-something foo)],
[qw(42 --extra-sausages foo)],
[qw(--ex foo 42)],
[qw(42 -q foo)],
[qw(-q foo 42)],
[qw(-r foo 42)],
[qw(-s foo 42)],
) {
my @pass = @$try;
my $o = $go->process(\@pass);
is($o->input, 'foo');
is_deeply(\@pass, [42]);
}
my @args = qw(foo 42);
my $o = $go->process(\@args);
is($o->input, 'foo');
is_deeply(\@args, [42]);
}
########################################################################
# boolean on/off
{
my $go = Getopt::Base->new();
$go->add_option(verbose => short => ['v'], default => 1);
$go->add_aliases(no_verbose => ['q'], 'quiet', 'hush');
foreach my $args (
[],
['-v'],
['--verbose'],
['--ve'],
['--v'],
) {
my $o = $go->process($args);
ok($o->verbose);
}
foreach my $args (
['-q'],
['--hush'],
['--hu'],
['--qui'],
['--quiet'],
['--verbose', '--no-verbose'],
['--verbose', '--no-ve'],
) {
my $o = $go->process($args);
ok(! $o->verbose);
}
}
########################################################################
# hashes and arrays
{
my $go = Getopt::Base->new();
$go->add_option(array => default => []);
$go->add_option(also => form => 'ARRAY');
$go->add_option(ahash => default => {});
my $o = $go->process([
'--array', 'foo', '--ahash', 'x=y',
'--array', 'y', '--ahash', 'y=x',
'--also', 7, '--also', 8,
'--array=bar', '--ahash=n=9',
]);
is_deeply([$o->array], [foo => y => bar =>]);
is_deeply({$o->ahash}, {x => 'y' => y => 'x', n => 9});
is_deeply([$o->also], [7,8]);
}
########################################################################
# isa
{
my $did_req;
my $source = 'package xthbbt;
no warnings "redefine"; # silly TAP::Harness -w junk
sub new {bless [@_, 19], "xthbbt"}
sub x {$_[0]->[1]} 1;';
local @INC = (
sub {
my ($code, $mod) = @_;
return unless($mod eq 'xthbbt.pm');
$did_req = 1;
open(my $fh, '<', \$source) or die $!;
return($fh);
},
@INC
);
{ # no default
my $go = Getopt::Base->new(
options => [xx => { type => 'string', isa => 'xthbbt' }]
);
my $o = $go->process(my $args = ['--xx', 'foo']);
ok($o);
is(scalar(@$args), 0);
ok($did_req, 'require ok');
is($o->xx->x, 'foo');
delete($INC{'xthbbt.pm'});
}
{ # simple default
my $go = Getopt::Base->new(
options => [xx => { type => 'string', isa => 'xthbbt',
default => 'nnn'}]
);
my $o = $go->process(my $args = []);
ok($o);
is(scalar(@$args), 0);
ok($did_req, 'require ok');
is($o->xx->x, 'nnn', 'default');
delete($INC{'xthbbt.pm'});
}
{ # code default
my $go = Getopt::Base->new(
options => [xx => { type => 'string', isa => 'xthbbt',
default => sub {'nnn'} }]
);
my $o = $go->process(my $args = []);
ok($o);
is(scalar(@$args), 0);
ok($did_req, 'require ok');
is($o->xx->x, 'nnn', 'coderef default');
delete($INC{'xthbbt.pm'});
}
{ # code default 2
my $go = Getopt::Base->new(
options => [xx => { type => 'string', isa => 'xthbbt',
default => sub {xthbbt->new('nnn')} }]
);
my $o = $go->process(my $args = []);
ok($o);
is(scalar(@$args), 0);
ok($did_req, 'require ok');
is($o->xx->x, 'nnn', 'coderef default');
delete($INC{'xthbbt.pm'});
}
}
########################################################################
# errors
{
eval {Getopt::Base->new(
positional => [qw(input)],
options => [ thing => { type => 'boolean', }, ],
)};
like($@, qr/^positional 'input' is not an option/);
eval {Getopt::Base->new(
positional => [qw(thing)],
options => [ thing => { type => 'boolean', }, ],
)};
like($@, qr/^positional 'thing' cannot be a boolean/);
eval {Getopt::Base->new(
options => [ -thing => { }, ],
)};
like($@, qr/^options cannot contain dashes \('-thing'\)/);
eval {Getopt::Base->new(
options => [ thing => { aliases => ['--foo']}, ],
)};
like($@, qr/^aliases cannot contain dashes \('--foo'\)/);
eval {Getopt::Base->new(
options => [thing => {short => ['x', 'yyy']}, ],
)};
like($@, qr/^short options must be only one character \('yyy'\)/);
{
my $go = Getopt::Base->new(
options => [xx => { type => 'string', isa => 'xthbbt' }]
);
eval { $go->process(my $args = ['--xx', 'foo']); };
like($@, qr/Can't locate xthbbt\.pm/);
}
}
########################################################################
ok(Getopt::Base->new(
positional => [qw(deal)],
options => [
thing => {
short => ['t'],
type => 'boolean',
default => 0,
},
deal => {
short => ['d'],
type => 'string',
default => '',
},
stuff => {
type => 'string',
default => [],
},
things => {
type => 'string',
default => {},
},
],
));
# vim:ts=2:sw=2:et:sta