call_checker.t revision 1.1 
1use warnings;
2use strict;
3use Test::More tests => 64;
4
5use XS::APItest;
6
7XS::APItest::test_cv_getset_call_checker();
8ok 1;
9
10my @z = ();
11my @a = qw(a);
12my @b = qw(a b);
13my @c = qw(a b c);
14
15my($foo_got, $foo_ret);
16sub foo($@) { $foo_got = [ @_ ]; return "z"; }
17
18sub bar (\@$) { }
19sub baz { }
20
21$foo_got = undef;
22eval q{$foo_ret = foo(@b, @c);};
23is $@, "";
24is_deeply $foo_got, [ 2, qw(a b c) ];
25is $foo_ret, "z";
26
27$foo_got = undef;
28eval q{$foo_ret = &foo(@b, @c);};
29is $@, "";
30is_deeply $foo_got, [ qw(a b), qw(a b c) ];
31is $foo_ret, "z";
32
33cv_set_call_checker_lists(\&foo);
34
35$foo_got = undef;
36eval q{$foo_ret = foo(@b, @c);};
37is $@, "";
38is_deeply $foo_got, [ qw(a b), qw(a b c) ];
39is $foo_ret, "z";
40
41$foo_got = undef;
42eval q{$foo_ret = &foo(@b, @c);};
43is $@, "";
44is_deeply $foo_got, [ qw(a b), qw(a b c) ];
45is $foo_ret, "z";
46
47cv_set_call_checker_scalars(\&foo);
48
49$foo_got = undef;
50eval q{$foo_ret = foo(@b, @c);};
51is $@, "";
52is_deeply $foo_got, [ 2, 3 ];
53is $foo_ret, "z";
54
55$foo_got = undef;
56eval q{$foo_ret = foo(@b, @c, @a, @c);};
57is $@, "";
58is_deeply $foo_got, [ 2, 3, 1, 3 ];
59is $foo_ret, "z";
60
61$foo_got = undef;
62eval q{$foo_ret = foo(@b);};
63is $@, "";
64is_deeply $foo_got, [ 2 ];
65is $foo_ret, "z";
66
67$foo_got = undef;
68eval q{$foo_ret = foo();};
69is $@, "";
70is_deeply $foo_got, [];
71is $foo_ret, "z";
72
73$foo_got = undef;
74eval q{$foo_ret = &foo(@b, @c);};
75is $@, "";
76is_deeply $foo_got, [ qw(a b), qw(a b c) ];
77is $foo_ret, "z";
78
79cv_set_call_checker_proto(\&foo, "\\\@\$");
80$foo_got = undef;
81eval q{$foo_ret = foo(@b, @c);};
82is $@, "";
83is_deeply $foo_got, [ \@b, 3 ];
84is $foo_ret, "z";
85
86cv_set_call_checker_proto(\&foo, undef);
87$foo_got = undef;
88eval q{$foo_ret = foo(@b, @c);};
89isnt $@, "";
90is_deeply $foo_got, undef;
91is $foo_ret, "z";
92
93cv_set_call_checker_proto(\&foo, \&bar);
94$foo_got = undef;
95eval q{$foo_ret = foo(@b, @c);};
96is $@, "";
97is_deeply $foo_got, [ \@b, 3 ];
98is $foo_ret, "z";
99
100cv_set_call_checker_proto(\&foo, \&baz);
101$foo_got = undef;
102eval q{$foo_ret = foo(@b, @c);};
103isnt $@, "";
104is_deeply $foo_got, undef;
105is $foo_ret, "z";
106
107cv_set_call_checker_proto_or_list(\&foo, "\\\@\$");
108$foo_got = undef;
109eval q{$foo_ret = foo(@b, @c);};
110is $@, "";
111is_deeply $foo_got, [ \@b, 3 ];
112is $foo_ret, "z";
113
114cv_set_call_checker_proto_or_list(\&foo, undef);
115$foo_got = undef;
116eval q{$foo_ret = foo(@b, @c);};
117is $@, "";
118is_deeply $foo_got, [ qw(a b), qw(a b c) ];
119is $foo_ret, "z";
120
121cv_set_call_checker_proto_or_list(\&foo, \&bar);
122$foo_got = undef;
123eval q{$foo_ret = foo(@b, @c);};
124is $@, "";
125is_deeply $foo_got, [ \@b, 3 ];
126is $foo_ret, "z";
127
128cv_set_call_checker_proto_or_list(\&foo, \&baz);
129$foo_got = undef;
130eval q{$foo_ret = foo(@b, @c);};
131is $@, "";
132is_deeply $foo_got, [ qw(a b), qw(a b c) ];
133is $foo_ret, "z";
134
135cv_set_call_checker_multi_sum(\&foo);
136
137$foo_got = undef;
138eval q{$foo_ret = foo(@b, @c);};
139is $@, "";
140is_deeply $foo_got, undef;
141is $foo_ret, 5;
142
143$foo_got = undef;
144eval q{$foo_ret = foo(@b);};
145is $@, "";
146is_deeply $foo_got, undef;
147is $foo_ret, 2;
148
149$foo_got = undef;
150eval q{$foo_ret = foo();};
151is $@, "";
152is_deeply $foo_got, undef;
153is $foo_ret, 0;
154
155$foo_got = undef;
156eval q{$foo_ret = foo(@b, @c, @a, @c);};
157is $@, "";
158is_deeply $foo_got, undef;
159is $foo_ret, 9;
160
1611;
162