view release on metacpan or  search on metacpan

t/callck.t  view on Meta::CPAN

is prototype(\&ck_entersub_args_list), "\$";
is prototype(\&ck_entersub_args_proto), "\$\$\$";
is prototype(\&ck_entersub_args_proto_or_list), "\$\$\$";
ok \&ck_entersub_args_proto != \&ck_entersub_args_proto_or_list;

my @z = ();
my @a = qw(a);
my @b = qw(a b);
my @c = qw(a b c);
sub foo($$) { [@_] }
sub bar(@) { [@_] }
my($ckfun, $ckobj);

is_deeply scalar(eval(q{foo(@b, @c)})), [ 2, 3 ];
is scalar(@{[cv_get_call_checker(\&foo)]}), 2;
($ckfun, $ckobj) = cv_get_call_checker(\&foo);
ok $ckfun == \&ck_entersub_args_proto_or_list;
ok $ckobj == \&foo;

cv_set_call_checker(\&foo, \&ck_entersub_args_proto_or_list, \"\$\@");
ok 1;

is scalar(@{[cv_get_call_checker(\&foo)]}), 2;
($ckfun, $ckobj) = cv_get_call_checker(\&foo);
ok $ckfun == \&ck_entersub_args_proto_or_list;
is_deeply $ckobj, \"\$\@";
is_deeply scalar(eval(q{foo(@b, @c)})), [ 2, qw(a b c) ];

my($scalars_called, $scalars_namegv, $scalars_ckobj, $scalars_argcount);
sub ckfun_scalars($$$) {
	my($entersubop, $namegv, $ckobj) = @_;
	$scalars_called++;
	$scalars_namegv = $namegv;
	$scalars_ckobj = $ckobj;
	my $pushop = $entersubop->first;
	$pushop = $pushop->first if $pushop->sibling->isa("B::NULL");
	my $aop = $pushop->sibling;
	$scalars_argcount = 0;
	until($aop->sibling->isa("B::NULL")) {
		$scalars_argcount++;

t/callck.t  view on Meta::CPAN

cv_set_call_checker(\&foo, \&ck_entersub_args_proto_or_list, \&bar);
ok 1;

is_deeply scalar(eval(q{foo(@b, @c)})), [ qw(a b a b c) ];
is scalar(@{[cv_get_call_checker(\&foo)]}), 2;
($ckfun, $ckobj) = cv_get_call_checker(\&foo);
ok $ckfun == \&ck_entersub_args_proto_or_list;
ok $ckobj == \&bar;

sub ckfun_lists($$$) {
	my($entersubop, $namegv, $ckobj) = @_;
	return ck_entersub_args_list($entersubop);
}

cv_set_call_checker(\&foo, \&ckfun_lists, \&foo);
ok 1;

is_deeply scalar(eval(q{foo(@b, @c)})), [ qw(a b a b c) ];
is scalar(@{[cv_get_call_checker(\&foo)]}), 2;
($ckfun, $ckobj) = cv_get_call_checker(\&foo);