ext/XS-APItest/t/looprest.t test recursive descent statement-sequence parsing
ext/XS-APItest/t/magic_chain.t test low-level MAGIC chain handling
ext/XS-APItest/t/Markers.pm Helper for ./blockhooks.t
+ext/XS-APItest/t/multicall.t XS::APItest: test MULTICALL macros
ext/XS-APItest/t/my_cxt.t XS::APItest: test MY_CXT interface
ext/XS-APItest/t/my_exit.t XS::APItest: test my_exit
ext/XS-APItest/t/Null.pm Helper for ./blockhooks.t
OUTPUT:
RETVAL
+=pod
+
+multicall_each: call a sub for each item in the list. Used to test MULTICALL
+
+=cut
+
+void
+multicall_each(block,...)
+ SV * block
+PROTOTYPE: &@
+CODE:
+{
+ dMULTICALL;
+ int index;
+ GV *gv;
+ HV *stash;
+ I32 gimme = G_SCALAR;
+ SV **args = &PL_stack_base[ax];
+ CV *cv;
+
+ if(items <= 1) {
+ XSRETURN_UNDEF;
+ }
+ cv = sv_2cv(block, &stash, &gv, 0);
+ if (cv == Nullcv) {
+ croak("multicall_each: not a subroutine reference");
+ }
+ PUSH_MULTICALL(cv);
+ SAVESPTR(GvSV(PL_defgv));
+
+ for(index = 1 ; index < items ; index++) {
+ GvSV(PL_defgv) = args[index];
+ MULTICALL;
+ }
+ POP_MULTICALL;
+ XSRETURN_UNDEF;
+}
+
+
BOOT:
{
HV* stash;
--- /dev/null
+#!perl -w
+
+# test the MULTICALL macros
+# Note: as of Oct 2010, there are not yet comprehensive tests
+# for these macros.
+
+use warnings;
+use strict;
+
+use Test::More tests => 4;
+use XS::APItest;
+
+
+{
+ my $sum = 0;
+ sub add { $sum += $_++ }
+
+ my @a = (1..3);
+ XS::APItest::multicall_each \&add, @a;
+ is($sum, 6, "sum okay");
+ is($a[0], 2, "a[0] okay");
+ is($a[1], 3, "a[1] okay");
+ is($a[2], 4, "a[2] okay");
+}