add skeleton testing for the MULTICALL macros

The macros dMULTICALL, PUSH_MULTICALL, MULTICALL and POP_MULTICALL
are completely untested in core apart from incidentally in List-Util.
The exercise they get there is probably quite comprehensive, but it's
not explicitly testing the macros themselves.

Add a hook and new test file to XS::APItest specifically for this purpose.
Currently the test file is almost empty.

The multicall_each function is shamelessly stolen from List:;Util::first.

diff --git a/MANIFEST b/MANIFEST
index 0aa5c0f..7f88eb3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3398,6 +3398,7 @@ ext/XS-APItest/t/keyword_plugin.t test keyword plugin mechanism
 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

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index e39281f..da37281 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2082,6 +2082,45 @@ rpeep_record ()
     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;

diff --git a/ext/XS-APItest/t/multicall.t b/ext/XS-APItest/t/multicall.t
new file mode 100644 (file)
index 0000000..4a86047
--- /dev/null
+++ b/ext/XS-APItest/t/multicall.t
@@ -0,0 +1,24 @@
+#!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");
+}