Getopt-O2

 view release on metacpan or  search on metacpan

t/02.getopt.t  view on Meta::CPAN

		CORE::exit($_[0] // 0);
	};

	use_ok('Getopt::O2');
}

use parent 'Getopt::O2';

# Usage called?
{
	local @ARGV = qw(-h);
	local $override{exit} = 1;

	my $cmdline = __PACKAGE__->new();
	my $mock = Test::MockObject::Extends->new($cmdline);

	$mock->mock(get_option_rules => sub {
		$cmdline->SUPER::get_option_rules,
		'e|enum=?' => ['A choice', 'values' => [qw(foo splort gnarf)]],
		'f|flag' => ['A flag', 'default' => undef],
		'p|param=s' => 'A parameter',

t/02.getopt.t  view on Meta::CPAN

# Code coverage #1
{
	my $usage;
	my $cmdline = bless {}, __PACKAGE__;
	$cmdline = $cmdline->new();
	pass('code.coverage.0');

	no warnings 'once';

	local $override{exit} = 1;
	local @ARGV = qw(--garble);

	eval {capture_stderr $usage, sub {
		$cmdline->getopt({});
	}};

	die $@ if 'ARRAY' ne ref $@;
	is($@->[0], 1, 'usage.exit.1');

	eval {capture_stderr $usage, sub {
		$cmdline->usage(0);

t/02.getopt.t  view on Meta::CPAN

	$mock->mock(get_option_rules => sub {
		return qw(flag)
	});
	eval {$mock->getopt({})};
	like($@, qr/^Not enough rules/, 'code.coverage.1');
}

# Test left-overs
{
	my @args = qw(--flag --param value -- --param value --flag one two three);
	local @ARGV = @args;
	my $cmdline = __PACKAGE__->new();
	my $mock = Test::MockObject::Extends->new($cmdline);
	my (%options, @leftover);

	$mock->mock(get_option_rules => sub {
		'flag' => 'A flag',
		'param=s' => 'A parameter'
	});

	$cmdline->getopt(\%options, \@leftover);
	is($options{flag}, 1, 'param.flag.0');
	is($options{param}, 'value', 'param.value.0');
	ok(@leftover ~~ @args[4..$#args], 'param.leftover.0');
}

# Unnamed parameters
{
	my @args = (qw(foo bar), undef, '', '-', '--');
	local @ARGV = @args;
	my (@out, %options);

	my $cmdline = __PACKAGE__->new();
	$cmdline->getopt(\%options, \@out);

	pop @args; # "--" is not used
	ok(@out ~~ @args, 'param.unnamed.0');
}

# Invalid option spec

t/02.getopt.t  view on Meta::CPAN

	eval {
		$mock->mock(error => sub {
			my $self = shift;
			my ($fmt, $arg) = @_;

			is($arg, 'snarf', 'param.invalid.long');

			die $mock;
		});

		local @ARGV = qw(--snarf);
		$mock->getopt(\%options);
	};

	die $@ unless blessed($@) && $mock == $@;
}

# Short options bundling and value
{
	local @ARGV = qw(-affoobert -a -bbba);

	my $cmdline = __PACKAGE__->new();
	my $mock = Test::MockObject::Extends->new($cmdline);
	my %options;

	$mock->mock(get_option_rules => sub {
		return
			'f|file=s' => 'File',
			'a|one+' => 'Flag #1',
			'b|two' => 'Flag #2';

t/02.getopt.t  view on Meta::CPAN

	$cmdline->getopt(\%options);

	is($options{one}, 3, 'params.short.bundle.0');
	is($options{two}, 1, 'params.short.bundle.1');
	is('foobert', $options{file}, 'params.short.value');
}

# Short options value after "=" and value as separate argument
{
	local @ARGV = qw(
		--one=two
		--three four
		--list 1 --list 2 --list 3
		--mode single
		--enum a --enum c
	);

	my $cmdline = __PACKAGE__->new();
	my $mock = Test::MockObject::Extends->new($cmdline);
	my %options;

t/02.getopt.t  view on Meta::CPAN

	foreach my $key (keys %param_sets) {
		my %options;
		my $set  = $param_sets{$key};
		my $cmdline = __PACKAGE__->new();
		my $mock = Test::MockObject::Extends->new($cmdline);

		$mock->mock(get_option_rules => sub {
			return @{$set->{set} || []};
		});

		local @ARGV = @{$set->{ARGV}};
		$mock->getopt(\%options);
		unless (ref $set->{opt_expect}) {
			is($options{$set->{opt_key}}, $set->{opt_expect}, $key);
		} elsif ('ARRAY' eq ref $set->{opt_expect}) {
			ok(@{$set->{opt_expect}} ~~ @{$options{$set->{opt_key}}}, $key);
		} else {
			fail("$key");
		}
	}
}

t/02.getopt.t  view on Meta::CPAN

			return @{$set->{set} || []};
		});
		$mock->mock(error => sub {
			my ($self, $fmt, $arg) = @_;

			is($arg, $set->{arg}, "$key.0");
			is($fmt, $set->{fmt}, "$key.1") if exists $set->{fmt};
			die $self;
		});

		local @ARGV = @{$set->{ARGV}};
		eval {$mock->getopt(\%options);1} and next;
		my $error = $@;
		if (blessed($error) && $mock == $error) {
		} elsif (!exists $set->{expect_error}) {
			die $error;
		} else {
			ok("$error" ~~ $set->{expect_error}, $key) || diag($error);
		}
	}
}