1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
#!/usr/bin/perl
use Getargs::Long qw(ignorecase);
use Test::More tests => 19;
require 't/code.pl';
## same test case as t/nocache.t, only with 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) = cxgetargs(@_,
{
-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) = cxgetargs(@_,
'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(@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);
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/);
|
