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