+#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
#else
RETVAL = 0;
#endif
+ OUTPUT:
+ RETVAL
void
print_long_double()
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));