Help language development. Donate to The Perl Foundation

Getopt::Long cpan:LEONT last updated on 2021-02-24

t/basic.t
use v6;

use Test;

use Getopt::Long;

my $capture = get-options-from(<--foo bar --fooo bar2 -f bar3 -ac --bar baz>, 'foo|f|[email protected]', 'bar', 'a', 'c');
is-deeply($capture, \('baz', :bar, :a, :c, :foo(Array[Str].new(<bar bar2 bar3>))), 'Common argument mix works');

multi main(*@, Str :fooo(:f(:@foo)), Bool :$bar) is getopt {
}
multi main(*@, Bool :$a!, Bool :$c!, Bool :$d) {
}
my $getopt = Getopt::Long.new-from-sub(&main);

my $capture2 = $getopt.get-options(<--foo bar --fooo bar2 --bar baz>);
is-deeply($capture2, \('baz', :bar, :foo(Array[Str].new(<bar bar2>))), 'Common argument mix works (2)');
lives-ok( { main(|$capture2) }, 'Calling main (1) works');

my $capture3 = $getopt.get-options(<-ac -dfbar3>);
is-deeply($capture3, \(:a, :c, :d, :foo(Array[Str].new(<bar3>))), 'Short options work');

my $capture4 = $getopt.get-options(<--foo bar --fooo bar2 -f bar3 -ac --bar baz>);
dies-ok( { main(|$capture4) }, 'Calling main (1) works');

my $capture5 = $getopt.get-options(<--bar -- -a>);
is-deeply($capture5, \('-a', :bar), '"--" terminates argument handling');

my $capture6 = get-options-from([<--quz=2.5>], 'quz=f');
is-deeply($capture6, \(:quz(2.5e0)), 'Floating point arguments work');

my $capture7 = get-options-from(['--quz'], 'quz:i');
is-deeply($capture7, \(:0quz), ':i without argument works');

my $capture8 = get-options-from(<--quz 2>, 'quz:i');
is-deeply($capture8, \(:2quz), ':i with argument works');

my $capture9 = get-options-from(['--quz'], 'quz:1');
is-deeply($capture9, \(:1quz), ':1 without argument works');

my $capture10 = get-options-from(<--quz 2>, 'quz:1');
is-deeply($capture10, \(:2quz), ':1 with argument works');

my $capture11 = get-options-from(<--foo --foo>, 'foo+');
is-deeply($capture11, \(:2foo), 'Counter adds up');

my $capture12 = get-options-from(['--foo'], 'foo:+');
is-deeply($capture12, \(:1foo), 'Colon singles fine');

my $capture13 = get-options-from(<--foo 2 --foo>, 'foo:+');
is-deeply($capture13, \(:3foo), 'Colon counter adds up');

my $capture14 = get-options-from(<--bar 0o12>, 'bar=i');
is-deeply($capture14, \(:10bar), 'Parsing octal argument with "i"');

my $capture15 = get-options-from(<--bar -0o12>, 'bar=i');
is-deeply($capture15, \(:bar(-10)), 'Parsing negative octal argument with "i"');

my $capture16 = get-options-from(<--bar 12>, 'bar=i');
is-deeply($capture16, \(:12bar), 'Parsing decimal argument with "i"');

my $capture17 = get-options-from(['--no-bar'], 'bar!');
is-deeply($capture17, \(:!bar), 'Negated arguments produce False');

my $capture18 = get-options-from(['-abc'], <a b c abc>, :!bundling);
is-deeply($capture18, \(:abc), 'Bundling can be disabled');

my $capture19 = get-options-from(['--foo', '1', '2', '3'], <foo=i{2}>);
is-deeply($capture19, \('3', :foo(Array[Int].new(1, 2))), 'Repeat specifier works');

my $capture20 = get-options-from(['--foo', '1', '2', '3'], <foo=i{1,2}>);
is-deeply($capture20, \('3', :foo(Array[Int].new(1, 2))), 'Repeat specifier works with range');

my sub main1(:$foo is option("=s%")) is getopt {};
ok(&main1.WHAT !=== Sub, 'sub main1 is not quite a Sub');
ok(&main1.WHAT.^name.contains('Parsed'), 'sub main1 is parsed');
my $getopt2 = Getopt::Long.new-from-sub(&main1);

my $capture21 = $getopt2.get-options(<--foo bar=buz --foo qaz=quz>);
my Str %expected = :bar('buz'), :qaz('quz');
is-deeply($capture21, \(:foo(%expected)), 'getopt trait works');

my $getopt3 = Getopt::Long.new-from-sub(sub (Bool :$foo = True) { });

my $capture22 = $getopt3.get-options(['--no-foo']);
is-deeply($capture22, \(:!foo), 'negative argument detected');

get-options-from([<--foo>], 'foo' => my $foo);
is-deeply($foo, True, 'Pair arguments');

get-options-from(<--foo 1 --foo 2>, '[email protected]' => my @foo);
is-deeply(@foo, [1, 2], 'Pair arguments');

my $capture23 = get-options-from(['--foo', '1+2i'], <foo=c>);
is-deeply($capture23, \(:foo(1+2i)), 'Repeat specifier works');

my $capture24 = get-options-from(['-f=1'], <f=i>, :compat-singles);
is-deeply($capture24, \(:f(1)), ':compat-singles appears to work');

my $capture25 = get-options-from(['-/f'], <f!>, :compat-negation);
is-deeply($capture25, \(:!f), ':compat-negation works');

my $capture26 = get-options-from(['--/f=foo'], <f=s>, :compat-negation);
ok(!$capture26<f>, 'compat negation delivers a false value');
is($capture26<f>, 'foo', 'compat negation delivers the correct string');

my $getopt4 = Getopt::Long.new-from-sub(sub (Order :$order) { });
my $capture27 = $getopt4.get-options(<--order Same>);
is($capture27, \(:order(Same)), 'Correctly parsed enum');

my $getopt5 = Getopt::Long.new-from-sub(sub (Int $foo, Rat $bar) { });
my $capture28 = $getopt5.get-options(["1", "2.5"]);
is($capture28, \(1, 2.5), 'Typed positionals work');

multi main2(Int $foo) { }
multi main2(Int $foo, Rat $bar) { }
my $getopt6 = Getopt::Long.new-from-sub(&main2);
my $capture29 = $getopt5.get-options(["1", "2.5"]);
is($capture29, \(1, 2.5), 'Typed positionals work on multis as well');

my $getopt7 = Getopt::Long.new-from-sub(sub (DateTime :$datetime) { });
my $capture30 = $getopt7.get-options(<--datetime 2015-11-21T08:01:00+0100 >);
is($capture30, \(:datetime(DateTime.new(:2015year, :11month, :21day, :8hour, :1minute, :3600timezone))), 'Can parse DateTime');

my $capture31 = get-options-from(<--date 2015-11-21>, <date=a>);
is-deeply($capture31, \(:date(Date.new(:2015year, :11month, :21day))), 'Can parse Date');

my $capture32 = get-options-from(<--lo --lon>, <long+>, :auto-abbreviate);
is-deeply($capture32, \(:2long), 'Can auto-abbreviate');

class Foo {
	has Int:D $.value is required;
	method COERCE(Int(Str) $value) {
		return Foo.new(:$value);
	}
}

if $*RAKU.compiler.version after 2020.10 {
	my $getopt8 = Getopt::Long.new-from-sub(sub (Foo(Str) :$foo) { });
	my $capture33 = $getopt8.get-options(['--foo', '1']);
	is-deeply($capture33<foo>, Foo.new(:value(1)), 'Parse a custom parseable type');

	throws-like({
		call-with-getopt(sub (Signature(Str) :$bar) { dd $bar }, ['--bar', '1']);
	}, Getopt::Long::Exception, 'No conversion known for type Signature');
}

my $capture34 = get-options-from(['-vjb'], <v j=s b>);
is-deeply($capture34, \(:v, :j<b>), 'Bundled options with arguments work');

my $capture35 = get-options-from(<--foo baz --bar>, <foo bar>, :!permute);
is-deeply($capture35, \(:foo, 'baz', '--bar'), ':!permute works');

my $getopt9 = Getopt::Long.new-from-sub(sub (Str :$foo is option(*.flip)) {});
my $capture36 = $getopt9.get-options(<--foo bar>);
is-deeply($capture36, \(:foo<rab>), 'Custom converter works');

my $capture37 = get-options-from(['--foo', '2'], <foo:1>, :compat-space);
is-deeply($capture37, \('2', :1foo), '');

done-testing;