This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
New XS::APItest's for sv_peek based on my DDumper work
[perl5.git] / ext / XS / APItest / APItest.xs
index 1e8ea35..b81e86d 100644 (file)
+#define PERL_IN_XS_APITEST
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 
+
+/* for my_cxt tests */
+
+#define MY_CXT_KEY "XS::APItest::_guts" XS_VERSION
+
+typedef struct {
+    int i;
+    SV *sv;
+} my_cxt_t;
+
+START_MY_CXT
+
+/* indirect functions to test the [pa]MY_CXT macros */
+
+int
+my_cxt_getint_p(pMY_CXT)
+{
+    return MY_CXT.i;
+}
+
+void
+my_cxt_setint_p(pMY_CXT_ int i)
+{
+    MY_CXT.i = i;
+}
+
+SV*
+my_cxt_getsv_interp_context(void)
+{
+    dTHX;
+    dMY_CXT_INTERP(my_perl);
+    return MY_CXT.sv;
+}
+
+SV*
+my_cxt_getsv_interp(void)
+{
+    dMY_CXT;
+    return MY_CXT.sv;
+}
+
+void
+my_cxt_setsv_p(SV* sv _pMY_CXT)
+{
+    MY_CXT.sv = sv;
+}
+
+
+/* from exception.c */
+int apitest_exception(int);
+
+/* from core_or_not.inc */
+bool sv_setsv_cow_hashkey_core(void);
+bool sv_setsv_cow_hashkey_notcore(void);
+
+/* A routine to test hv_delayfree_ent
+   (which itself is tested by testing on hv_free_ent  */
+
+typedef void (freeent_function)(pTHX_ HV *, register HE *);
+
+void
+test_freeent(freeent_function *f) {
+    dTHX;
+    dSP;
+    HV *test_hash = newHV();
+    HE *victim;
+    SV *test_scalar;
+    U32 results[4];
+    int i;
+
+#ifdef PURIFY
+    victim = (HE*)safemalloc(sizeof(HE));
+#else
+    /* Storing then deleting something should ensure that a hash entry is
+       available.  */
+    hv_store(test_hash, "", 0, &PL_sv_yes, 0);
+    hv_delete(test_hash, "", 0, 0);
+
+    /* We need to "inline" new_he here as it's static, and the functions we
+       test expect to be able to call del_HE on the HE  */
+    if (!PL_body_roots[HE_SVSLOT])
+       croak("PL_he_root is 0");
+    victim = (HE*) PL_body_roots[HE_SVSLOT];
+    PL_body_roots[HE_SVSLOT] = HeNEXT(victim);
+#endif
+
+    victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
+
+    test_scalar = newSV(0);
+    SvREFCNT_inc(test_scalar);
+    HeVAL(victim) = test_scalar;
+
+    /* Need this little game else we free the temps on the return stack.  */
+    results[0] = SvREFCNT(test_scalar);
+    SAVETMPS;
+    results[1] = SvREFCNT(test_scalar);
+    f(aTHX_ test_hash, victim);
+    results[2] = SvREFCNT(test_scalar);
+    FREETMPS;
+    results[3] = SvREFCNT(test_scalar);
+
+    i = 0;
+    do {
+       mPUSHu(results[i]);
+    } while (++i < sizeof(results)/sizeof(results[0]));
+
+    /* Goodbye to our extra reference.  */
+    SvREFCNT_dec(test_scalar);
+}
+
+
+static I32
+bitflip_key(pTHX_ IV action, SV *field) {
+    MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
+    SV *keysv;
+    if (mg && (keysv = mg->mg_obj)) {
+       STRLEN len;
+       const char *p = SvPV(keysv, len);
+
+       if (len) {
+           SV *newkey = newSV(len);
+           char *new_p = SvPVX(newkey);
+
+           if (SvUTF8(keysv)) {
+               const char *const end = p + len;
+               while (p < end) {
+                   STRLEN len;
+                   UV chr = utf8_to_uvuni((U8 *)p, &len);
+                   new_p = (char *)uvuni_to_utf8((U8 *)new_p, chr ^ 32);
+                   p += len;
+               }
+               SvUTF8_on(newkey);
+           } else {
+               while (len--)
+                   *new_p++ = *p++ ^ 32;
+           }
+           *new_p = '\0';
+           SvCUR_set(newkey, SvCUR(keysv));
+           SvPOK_on(newkey);
+
+           mg->mg_obj = newkey;
+       }
+    }
+    return 0;
+}
+
+static I32
+rot13_key(pTHX_ IV action, SV *field) {
+    MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
+    SV *keysv;
+    if (mg && (keysv = mg->mg_obj)) {
+       STRLEN len;
+       const char *p = SvPV(keysv, len);
+
+       if (len) {
+           SV *newkey = newSV(len);
+           char *new_p = SvPVX(newkey);
+
+           /* There's a deliberate fencepost error here to loop len + 1 times
+              to copy the trailing \0  */
+           do {
+               char new_c = *p++;
+               /* Try doing this cleanly and clearly in EBCDIC another way: */
+               switch (new_c) {
+               case 'A': new_c = 'N'; break;
+               case 'B': new_c = 'O'; break;
+               case 'C': new_c = 'P'; break;
+               case 'D': new_c = 'Q'; break;
+               case 'E': new_c = 'R'; break;
+               case 'F': new_c = 'S'; break;
+               case 'G': new_c = 'T'; break;
+               case 'H': new_c = 'U'; break;
+               case 'I': new_c = 'V'; break;
+               case 'J': new_c = 'W'; break;
+               case 'K': new_c = 'X'; break;
+               case 'L': new_c = 'Y'; break;
+               case 'M': new_c = 'Z'; break;
+               case 'N': new_c = 'A'; break;
+               case 'O': new_c = 'B'; break;
+               case 'P': new_c = 'C'; break;
+               case 'Q': new_c = 'D'; break;
+               case 'R': new_c = 'E'; break;
+               case 'S': new_c = 'F'; break;
+               case 'T': new_c = 'G'; break;
+               case 'U': new_c = 'H'; break;
+               case 'V': new_c = 'I'; break;
+               case 'W': new_c = 'J'; break;
+               case 'X': new_c = 'K'; break;
+               case 'Y': new_c = 'L'; break;
+               case 'Z': new_c = 'M'; break;
+               case 'a': new_c = 'n'; break;
+               case 'b': new_c = 'o'; break;
+               case 'c': new_c = 'p'; break;
+               case 'd': new_c = 'q'; break;
+               case 'e': new_c = 'r'; break;
+               case 'f': new_c = 's'; break;
+               case 'g': new_c = 't'; break;
+               case 'h': new_c = 'u'; break;
+               case 'i': new_c = 'v'; break;
+               case 'j': new_c = 'w'; break;
+               case 'k': new_c = 'x'; break;
+               case 'l': new_c = 'y'; break;
+               case 'm': new_c = 'z'; break;
+               case 'n': new_c = 'a'; break;
+               case 'o': new_c = 'b'; break;
+               case 'p': new_c = 'c'; break;
+               case 'q': new_c = 'd'; break;
+               case 'r': new_c = 'e'; break;
+               case 's': new_c = 'f'; break;
+               case 't': new_c = 'g'; break;
+               case 'u': new_c = 'h'; break;
+               case 'v': new_c = 'i'; break;
+               case 'w': new_c = 'j'; break;
+               case 'x': new_c = 'k'; break;
+               case 'y': new_c = 'l'; break;
+               case 'z': new_c = 'm'; break;
+               }
+               *new_p++ = new_c;
+           } while (len--);
+           SvCUR_set(newkey, SvCUR(keysv));
+           SvPOK_on(newkey);
+           if (SvUTF8(keysv))
+               SvUTF8_on(newkey);
+
+           mg->mg_obj = newkey;
+       }
+    }
+    return 0;
+}
+
+STATIC I32
+rmagical_a_dummy(pTHX_ IV idx, SV *sv) {
+    return 0;
+}
+
+STATIC MGVTBL rmagical_b = { 0 };
+
+#include "const-c.inc"
+
+MODULE = XS::APItest:Hash              PACKAGE = XS::APItest::Hash
+
+INCLUDE: const-xs.inc
+
+void
+rot13_hash(hash)
+       HV *hash
+       CODE:
+       {
+           struct ufuncs uf;
+           uf.uf_val = rot13_key;
+           uf.uf_set = 0;
+           uf.uf_index = 0;
+
+           sv_magic((SV*)hash, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
+       }
+
+void
+bitflip_hash(hash)
+       HV *hash
+       CODE:
+       {
+           struct ufuncs uf;
+           uf.uf_val = bitflip_key;
+           uf.uf_set = 0;
+           uf.uf_index = 0;
+
+           sv_magic((SV*)hash, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
+       }
+
+#define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)
+
+bool
+exists(hash, key_sv)
+       PREINIT:
+       STRLEN len;
+       const char *key;
+       INPUT:
+       HV *hash
+       SV *key_sv
+       CODE:
+       key = SvPV(key_sv, len);
+       RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
+        OUTPUT:
+        RETVAL
+
+bool
+exists_ent(hash, key_sv)
+       PREINIT:
+       INPUT:
+       HV *hash
+       SV *key_sv
+       CODE:
+       RETVAL = hv_exists_ent(hash, key_sv, 0);
+        OUTPUT:
+        RETVAL
+
+SV *
+delete(hash, key_sv, flags = 0)
+       PREINIT:
+       STRLEN len;
+       const char *key;
+       INPUT:
+       HV *hash
+       SV *key_sv
+       I32 flags;
+       CODE:
+       key = SvPV(key_sv, len);
+       /* It's already mortal, so need to increase reference count.  */
+       RETVAL
+           = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), flags));
+        OUTPUT:
+        RETVAL
+
+SV *
+delete_ent(hash, key_sv, flags = 0)
+       INPUT:
+       HV *hash
+       SV *key_sv
+       I32 flags;
+       CODE:
+       /* It's already mortal, so need to increase reference count.  */
+       RETVAL = SvREFCNT_inc(hv_delete_ent(hash, key_sv, flags, 0));
+        OUTPUT:
+        RETVAL
+
+SV *
+store_ent(hash, key, value)
+       PREINIT:
+       SV *copy;
+       HE *result;
+       INPUT:
+       HV *hash
+       SV *key
+       SV *value
+       CODE:
+       copy = newSV(0);
+       result = hv_store_ent(hash, key, copy, 0);
+       SvSetMagicSV(copy, value);
+       if (!result) {
+           SvREFCNT_dec(copy);
+           XSRETURN_EMPTY;
+       }
+       /* It's about to become mortal, so need to increase reference count.
+        */
+       RETVAL = SvREFCNT_inc(HeVAL(result));
+        OUTPUT:
+        RETVAL
+
+SV *
+store(hash, key_sv, value)
+       PREINIT:
+       STRLEN len;
+       const char *key;
+       SV *copy;
+       SV **result;
+       INPUT:
+       HV *hash
+       SV *key_sv
+       SV *value
+       CODE:
+       key = SvPV(key_sv, len);
+       copy = newSV(0);
+       result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
+       SvSetMagicSV(copy, value);
+       if (!result) {
+           SvREFCNT_dec(copy);
+           XSRETURN_EMPTY;
+       }
+       /* It's about to become mortal, so need to increase reference count.
+        */
+       RETVAL = SvREFCNT_inc(*result);
+        OUTPUT:
+        RETVAL
+
+SV *
+fetch_ent(hash, key_sv)
+       PREINIT:
+       HE *result;
+       INPUT:
+       HV *hash
+       SV *key_sv
+       CODE:
+       result = hv_fetch_ent(hash, key_sv, 0, 0);
+       if (!result) {
+           XSRETURN_EMPTY;
+       }
+       /* Force mg_get  */
+       RETVAL = newSVsv(HeVAL(result));
+        OUTPUT:
+        RETVAL
+
+SV *
+fetch(hash, key_sv)
+       PREINIT:
+       STRLEN len;
+       const char *key;
+       SV **result;
+       INPUT:
+       HV *hash
+       SV *key_sv
+       CODE:
+       key = SvPV(key_sv, len);
+       result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
+       if (!result) {
+           XSRETURN_EMPTY;
+       }
+       /* Force mg_get  */
+       RETVAL = newSVsv(*result);
+        OUTPUT:
+        RETVAL
+
+#if defined (hv_common)
+
+SV *
+common(params)
+       INPUT:
+       HV *params
+       PREINIT:
+       HE *result;
+       HV *hv = NULL;
+       SV *keysv = NULL;
+       const char *key = NULL;
+       STRLEN klen = 0;
+       int flags = 0;
+       int action = 0;
+       SV *val = NULL;
+       U32 hash = 0;
+       SV **svp;
+       CODE:
+       if ((svp = hv_fetchs(params, "hv", 0))) {
+           SV *const rv = *svp;
+           if (!SvROK(rv))
+               croak("common passed a non-reference for parameter hv");
+           hv = (HV *)SvRV(rv);
+       }
+       if ((svp = hv_fetchs(params, "keysv", 0)))
+           keysv = *svp;
+       if ((svp = hv_fetchs(params, "keypv", 0))) {
+           key = SvPV_const(*svp, klen);
+           if (SvUTF8(*svp))
+               flags = HVhek_UTF8;
+       }
+       if ((svp = hv_fetchs(params, "action", 0)))
+           action = SvIV(*svp);
+       if ((svp = hv_fetchs(params, "val", 0)))
+           val = *svp;
+       if ((svp = hv_fetchs(params, "hash", 0)))
+           action = SvUV(*svp);
+
+       result = (HE *)hv_common(hv, keysv, key, klen, flags, action, val, hash);
+       if (!result) {
+           XSRETURN_EMPTY;
+       }
+       /* Force mg_get  */
+       RETVAL = newSVsv(HeVAL(result));
+        OUTPUT:
+        RETVAL
+
+#endif
+
+void
+test_hv_free_ent()
+       PPCODE:
+       test_freeent(&Perl_hv_free_ent);
+       XSRETURN(4);
+
+void
+test_hv_delayfree_ent()
+       PPCODE:
+       test_freeent(&Perl_hv_delayfree_ent);
+       XSRETURN(4);
+
+SV *
+test_share_unshare_pvn(input)
+       PREINIT:
+       STRLEN len;
+       U32 hash;
+       char *pvx;
+       char *p;
+       INPUT:
+       SV *input
+       CODE:
+       pvx = SvPV(input, len);
+       PERL_HASH(hash, pvx, len);
+       p = sharepvn(pvx, len, hash);
+       RETVAL = newSVpvn(p, len);
+       unsharepvn(p, len, hash);
+       OUTPUT:
+       RETVAL
+
+#if PERL_VERSION >= 9
+
+bool
+refcounted_he_exists(key, level=0)
+       SV *key
+       IV level
+       CODE:
+       if (level) {
+           croak("level must be zero, not %"IVdf, level);
+       }
+       RETVAL = (Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
+                                          key, NULL, 0, 0, 0)
+                 != &PL_sv_placeholder);
+       OUTPUT:
+       RETVAL
+
+SV *
+refcounted_he_fetch(key, level=0)
+       SV *key
+       IV level
+       CODE:
+       if (level) {
+           croak("level must be zero, not %"IVdf, level);
+       }
+       RETVAL = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, key,
+                                         NULL, 0, 0, 0);
+       SvREFCNT_inc(RETVAL);
+       OUTPUT:
+       RETVAL
+       
+#endif
+       
+=pod
+
+sub TIEHASH  { bless {}, $_[0] }
+sub STORE    { $_[0]->{$_[1]} = $_[2] }
+sub FETCH    { $_[0]->{$_[1]} }
+sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
+sub NEXTKEY  { each %{$_[0]} }
+sub EXISTS   { exists $_[0]->{$_[1]} }
+sub DELETE   { delete $_[0]->{$_[1]} }
+sub CLEAR    { %{$_[0]} = () }
+
+=cut
+
 MODULE = XS::APItest           PACKAGE = XS::APItest
 
 PROTOTYPES: DISABLE
 
+BOOT:
+{
+    MY_CXT_INIT;
+    MY_CXT.i  = 99;
+    MY_CXT.sv = newSVpv("initial",0);
+}                              
+
+void
+CLONE(...)
+    CODE:
+    MY_CXT_CLONE;
+    MY_CXT.sv = newSVpv("initial_clone",0);
+
 void
 print_double(val)
         double val
@@ -20,6 +569,8 @@ have_long_double()
 #else
         RETVAL = 0;
 #endif
+        OUTPUT:
+        RETVAL
 
 void
 print_long_double()
@@ -51,3 +602,284 @@ print_float(val)
         float val
         CODE:
         printf("%5.3f\n",val);
+       
+void
+print_flush()
+       CODE:
+       fflush(stdout);
+
+void
+mpushp()
+       PPCODE:
+       EXTEND(SP, 3);
+       mPUSHp("one", 3);
+       mPUSHp("two", 3);
+       mPUSHp("three", 5);
+       XSRETURN(3);
+
+void
+mpushn()
+       PPCODE:
+       EXTEND(SP, 3);
+       mPUSHn(0.5);
+       mPUSHn(-0.25);
+       mPUSHn(0.125);
+       XSRETURN(3);
+
+void
+mpushi()
+       PPCODE:
+       EXTEND(SP, 3);
+       mPUSHi(-1);
+       mPUSHi(2);
+       mPUSHi(-3);
+       XSRETURN(3);
+
+void
+mpushu()
+       PPCODE:
+       EXTEND(SP, 3);
+       mPUSHu(1);
+       mPUSHu(2);
+       mPUSHu(3);
+       XSRETURN(3);
+
+void
+mxpushp()
+       PPCODE:
+       mXPUSHp("one", 3);
+       mXPUSHp("two", 3);
+       mXPUSHp("three", 5);
+       XSRETURN(3);
+
+void
+mxpushn()
+       PPCODE:
+       mXPUSHn(0.5);
+       mXPUSHn(-0.25);
+       mXPUSHn(0.125);
+       XSRETURN(3);
+
+void
+mxpushi()
+       PPCODE:
+       mXPUSHi(-1);
+       mXPUSHi(2);
+       mXPUSHi(-3);
+       XSRETURN(3);
+
+void
+mxpushu()
+       PPCODE:
+       mXPUSHu(1);
+       mXPUSHu(2);
+       mXPUSHu(3);
+       XSRETURN(3);
+
+
+void
+call_sv(sv, flags, ...)
+    SV* sv
+    I32 flags
+    PREINIT:
+       I32 i;
+    PPCODE:
+       for (i=0; i<items-2; i++)
+           ST(i) = ST(i+2); /* pop first two args */
+       PUSHMARK(SP);
+       SP += items - 2;
+       PUTBACK;
+       i = call_sv(sv, flags);
+       SPAGAIN;
+       EXTEND(SP, 1);
+       PUSHs(sv_2mortal(newSViv(i)));
+
+void
+call_pv(subname, flags, ...)
+    char* subname
+    I32 flags
+    PREINIT:
+       I32 i;
+    PPCODE:
+       for (i=0; i<items-2; i++)
+           ST(i) = ST(i+2); /* pop first two args */
+       PUSHMARK(SP);
+       SP += items - 2;
+       PUTBACK;
+       i = call_pv(subname, flags);
+       SPAGAIN;
+       EXTEND(SP, 1);
+       PUSHs(sv_2mortal(newSViv(i)));
+
+void
+call_method(methname, flags, ...)
+    char* methname
+    I32 flags
+    PREINIT:
+       I32 i;
+    PPCODE:
+       for (i=0; i<items-2; i++)
+           ST(i) = ST(i+2); /* pop first two args */
+       PUSHMARK(SP);
+       SP += items - 2;
+       PUTBACK;
+       i = call_method(methname, flags);
+       SPAGAIN;
+       EXTEND(SP, 1);
+       PUSHs(sv_2mortal(newSViv(i)));
+
+void
+eval_sv(sv, flags)
+    SV* sv
+    I32 flags
+    PREINIT:
+       I32 i;
+    PPCODE:
+       PUTBACK;
+       i = eval_sv(sv, flags);
+       SPAGAIN;
+       EXTEND(SP, 1);
+       PUSHs(sv_2mortal(newSViv(i)));
+
+void
+eval_pv(p, croak_on_error)
+    const char* p
+    I32 croak_on_error
+    PPCODE:
+       PUTBACK;
+       EXTEND(SP, 1);
+       PUSHs(eval_pv(p, croak_on_error));
+
+void
+require_pv(pv)
+    const char* pv
+    PPCODE:
+       PUTBACK;
+       require_pv(pv);
+
+int
+apitest_exception(throw_e)
+    int throw_e
+    OUTPUT:
+        RETVAL
+
+void
+mycroak(sv)
+    SV* sv
+    CODE:
+    if (SvOK(sv)) {
+        Perl_croak(aTHX_ "%s", SvPV_nolen(sv));
+    }
+    else {
+       Perl_croak(aTHX_ NULL);
+    }
+
+SV*
+strtab()
+   CODE:
+   RETVAL = newRV_inc((SV*)PL_strtab);
+   OUTPUT:
+   RETVAL
+
+int
+my_cxt_getint()
+    CODE:
+       dMY_CXT;
+       RETVAL = my_cxt_getint_p(aMY_CXT);
+    OUTPUT:
+        RETVAL
+
+void
+my_cxt_setint(i)
+    int i;
+    CODE:
+       dMY_CXT;
+       my_cxt_setint_p(aMY_CXT_ i);
+
+void
+my_cxt_getsv(how)
+    bool how;
+    PPCODE:
+       EXTEND(SP, 1);
+       ST(0) = how ? my_cxt_getsv_interp_context() : my_cxt_getsv_interp();
+       XSRETURN(1);
+
+void
+my_cxt_setsv(sv)
+    SV *sv;
+    CODE:
+       dMY_CXT;
+       SvREFCNT_dec(MY_CXT.sv);
+       my_cxt_setsv_p(sv _aMY_CXT);
+       SvREFCNT_inc(sv);
+
+bool
+sv_setsv_cow_hashkey_core()
+
+bool
+sv_setsv_cow_hashkey_notcore()
+
+void
+rmagical_cast(sv, type)
+    SV *sv;
+    SV *type;
+    PREINIT:
+       struct ufuncs uf;
+    PPCODE:
+       if (!SvOK(sv) || !SvROK(sv) || !SvOK(type)) { XSRETURN_UNDEF; }
+       sv = SvRV(sv);
+       if (SvTYPE(sv) != SVt_PVHV) { XSRETURN_UNDEF; }
+       uf.uf_val = rmagical_a_dummy;
+       uf.uf_set = NULL;
+       uf.uf_index = 0;
+       if (SvTRUE(type)) { /* b */
+           sv_magicext(sv, NULL, PERL_MAGIC_ext, &rmagical_b, NULL, 0);
+       } else { /* a */
+           sv_magic(sv, NULL, PERL_MAGIC_uvar, (char *) &uf, sizeof(uf));
+       }
+       XSRETURN_YES;
+
+void
+rmagical_flags(sv)
+    SV *sv;
+    PPCODE:
+       if (!SvOK(sv) || !SvROK(sv)) { XSRETURN_UNDEF; }
+       sv = SvRV(sv);
+        EXTEND(SP, 3); 
+       mXPUSHu(SvFLAGS(sv) & SVs_GMG);
+       mXPUSHu(SvFLAGS(sv) & SVs_SMG);
+       mXPUSHu(SvFLAGS(sv) & SVs_RMG);
+        XSRETURN(3);
+
+void
+DPeek (sv)
+    SV   *sv
+
+  PPCODE:
+    ST (0) = newSVpv (Perl_sv_peek (sv), 0);
+    XSRETURN (1);
+
+void
+BEGIN()
+    CODE:
+       sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
+
+void
+CHECK()
+    CODE:
+       sv_inc(get_sv("XS::APItest::CHECK_called", GV_ADD|GV_ADDMULTI));
+
+void
+UNITCHECK()
+    CODE:
+       sv_inc(get_sv("XS::APItest::UNITCHECK_called", GV_ADD|GV_ADDMULTI));
+
+void
+INIT()
+    CODE:
+       sv_inc(get_sv("XS::APItest::INIT_called", GV_ADD|GV_ADDMULTI));
+
+void
+END()
+    CODE:
+       sv_inc(get_sv("XS::APItest::END_called", GV_ADD|GV_ADDMULTI));