#!./perl

use Getargs::Long qw(ignorecase);
use Test::More tests => 23;

require 't/code.pl';

## same test case as t/cache.t, only without using c*() routines.

package BAR;

sub make { bless {}, shift }

package FOO;

@ISA = qw(BAR);

package main;

my $FOO = FOO->make;
my $BAR = BAR->make;

sub try {
	my ($x, $y, $z, $t, $o, @other) = xgetargs(@_,
		{
			-strict => 0,
			-extra => 0,
			-inplace => 1,
		},
		'x'		=>	['i', 1],
		-y		=>	['ARRAY', ['a', 'b']],
		'z'		=>	[],
		't'		=>  ['FOO', $FOO],
		-o 		=>  'i',
	);
	return ([$x, $y, $z, $t, $o], \@other, [@_]);
}

sub tryw {
	my ($x, $y, $l, $z, $t) = xgetargs(@_,
		'x'		=>	['i'],			# integer, non-mandatory
		'y'		=>	['ARRAY', ['a', 'b']],		# Type, non-mandatory, default
		'l'		=>	[],				# anything, non-mandatory

		'z'		=>	undef,			# anything, mandatory
		't'		=> 'BAR'			# Type, mandatory
	);
	return ($x, $y, $z, $t);
}

my @a;
my ($x, $y, $z, $t);
my @other;
my @args;

@a = try(-o => -2, -t => $FOO, -Other => 2, ONE => 3);
($x, $y, $z, $t, $o) = @{$a[0]};
ok($x);
is(ref $y,'ARRAY');
is($y->[0],'a');
ok(!defined $z);
is(ref $t,'FOO');
is($o,-2);

@other = @{$a[1]};
is(scalar @other,0);

@args = @{$a[2]};
is(scalar @args,4);
is("@args","-Other 2 ONE 3");

eval { try(-t => $FOO) };
like($@,qr/\bargument 'o' missing\b/);

@a = try(-o => 1, -z => 'z', y => [], x => 5);
($x, $y, $z, $t, $o) = @{$a[0]};
is($x,5);
is($z,'z');
is(ref $y,'ARRAY');
is(scalar @$y,0);
is(ref $y,'ARRAY');
is(scalar @$y,0);
is(ref $y,'ARRAY');
is(scalar @$y,0);

eval { try(-o => undef, -z => 'z', y => [], x => 5) };
like($@,qr/'o' cannot be undef\b/);

eval { tryw(-Z => 'BIG Z', y => [], x => 5) };
like($@,qr/\bargument 't' missing\b/);

($x, $y, $z, $t) = tryw(-Z => 'BIG Z', y => [], x => 5, -t => $FOO);
is(ref $t,'FOO');

eval { tryw(-T => 1, -Z => 'BIG Z', y => [], x => 5) };
like($@,qr/'t' must be of type BAR but/);

eval {
	tryw(-T => $BAR, -Z => 'BIG Z', y => [], x => 5,
		-ExtraArg => 'extra-VALUE')
};
like($@,qr/\bswitch: -extraarg\b/);