path: root/ext/Devel/PPPort/PPPort.xs

/*******************************************************************************
*
*  !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
*
********************************************************************************
*
*  Perl/Pollution/Portability
*
********************************************************************************
*
*  $Revision: 9 $
*  $Author: mhx $
*  $Date: 2006/01/14 18:07:55 +0100 $
*
********************************************************************************
*
*  Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
*  Version 2.x, Copyright (C) 2001, Paul Marquess.
*  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
*
*  This program is free software; you can redistribute it and/or
*  modify it under the same terms as Perl itself.
*
*******************************************************************************/

/* ========== BEGIN XSHEAD ================================================== */



/* =========== END XSHEAD =================================================== */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

/* ========== BEGIN XSINIT ================================================== */

/* ---- from parts/inc/call ---- */
#define NEED_eval_pv

/* ---- from parts/inc/grok ---- */
#define NEED_grok_number
#define NEED_grok_numeric_radix
#define NEED_grok_bin
#define NEED_grok_hex
#define NEED_grok_oct

/* ---- from parts/inc/newCONSTSUB ---- */
#define NEED_newCONSTSUB

/* ---- from parts/inc/newRV ---- */
#define NEED_newRV_noinc

/* ---- from parts/inc/snprintf ---- */
#define NEED_my_snprintf

/* ---- from parts/inc/sv_xpvf ---- */
#define NEED_vnewSVpvf
#define NEED_sv_catpvf_mg
#define NEED_sv_catpvf_mg_nocontext
#define NEED_sv_setpvf_mg
#define NEED_sv_setpvf_mg_nocontext

/* ---- from parts/inc/SvPV ---- */
#define NEED_sv_2pv_nolen
#define NEED_sv_2pvbyte

/* ---- from parts/inc/variables ---- */
#define NEED_PL_signals

/* ---- from parts/inc/warn ---- */
#define NEED_warner

/* =========== END XSINIT =================================================== */

#include "ppport.h"

/* ========== BEGIN XSMISC ================================================== */

/* ---- from parts/inc/exception ---- */
/* defined in module3.c */
int exception(int throw_e);

/* ---- from parts/inc/misc ---- */
XS(XS_Devel__PPPort_dXSTARG);  /* prototype */
XS(XS_Devel__PPPort_dXSTARG)
{
  dXSARGS;
  dXSTARG;
  IV iv;
  SP -= items;
  iv = SvIV(ST(0)) + 1;
  PUSHi(iv);
  XSRETURN(1);
}

XS(XS_Devel__PPPort_dAXMARK);  /* prototype */
XS(XS_Devel__PPPort_dAXMARK)
{
  dSP;
  dAXMARK;
  dITEMS;
  IV iv;
  SP -= items;
  iv = SvIV(ST(0)) - 1;
  PUSHs(sv_2mortal(newSViv(iv)));
  XSRETURN(1);
}

/* ---- from parts/inc/MY_CXT ---- */
#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION

typedef struct {
  /* Put Global Data in here */
  int dummy;
} my_cxt_t;

START_MY_CXT

/* ---- from parts/inc/newCONSTSUB ---- */
void call_newCONSTSUB_1(void)
{
#ifdef PERL_NO_GET_CONTEXT
	dTHX;
#endif
	newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
}

extern void call_newCONSTSUB_2(void);
extern void call_newCONSTSUB_3(void);

/* ---- from parts/inc/sv_xpvf ---- */
static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
{
  SV *sv;
  va_list args;
  va_start(args, pat);
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
  sv = vnewSVpvf(pat, &args);
#else
  sv = newSVpv(pat, 0);
#endif
  va_end(args);
  return sv;
}

static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
{
  va_list args;
  va_start(args, pat);
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
  sv_vcatpvf(sv, pat, &args);
#else
  sv_catpv(sv, pat);
#endif
  va_end(args);
}

static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
{
  va_list args;
  va_start(args, pat);
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
  sv_vsetpvf(sv, pat, &args);
#else
  sv_setpv(sv, pat);
#endif
  va_end(args);
}

/* ---- from parts/inc/variables ---- */
U32 get_PL_signals_1(void)
{
  return PL_signals;
}

extern U32 get_PL_signals_2(void);
extern U32 get_PL_signals_3(void);

/* =========== END XSMISC =================================================== */

MODULE = Devel::PPPort		PACKAGE = Devel::PPPort

BOOT:
	/* ---- from parts/inc/misc ---- */
	newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
	newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
	
	/* ---- from parts/inc/MY_CXT ---- */
	{
	  MY_CXT_INIT;
	  /* If any of the fields in the my_cxt_t struct need
	   * to be initialised, do it here.
	   */
	  MY_CXT.dummy = 42;
	}
	

##----------------------------------------------------------------------
##  XSUBs from parts/inc/call
##----------------------------------------------------------------------

I32
G_SCALAR()
	CODE:
		RETVAL = G_SCALAR;
	OUTPUT:
		RETVAL

I32
G_ARRAY()
	CODE:
		RETVAL = G_ARRAY;
	OUTPUT:
		RETVAL

I32
G_DISCARD()
	CODE:
		RETVAL = G_DISCARD;
	OUTPUT:
		RETVAL

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)
	char* p
	I32 croak_on_error
	PPCODE:
		PUTBACK;
		EXTEND(SP, 1);
		PUSHs(eval_pv(p, croak_on_error));

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_argv(subname, flags, ...)
	char* subname
	I32 flags
	PREINIT:
		I32 i;
		char *args[8];
	PPCODE:
		if (items > 8)  /* play safe */
		  XSRETURN_UNDEF;
		for (i=2; i<items; i++)
		  args[i-2] = SvPV_nolen(ST(i));
		args[items-2] = NULL;
		PUTBACK;
		i = call_argv(subname, flags, args);
		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)));

##----------------------------------------------------------------------
##  XSUBs from parts/inc/cop
##----------------------------------------------------------------------

char *
CopSTASHPV()
	CODE:
		RETVAL = CopSTASHPV(PL_curcop);
	OUTPUT:
		RETVAL

char *
CopFILE()
	CODE:
		RETVAL = CopFILE(PL_curcop);
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/exception
##----------------------------------------------------------------------

int
exception(throw_e)
  int throw_e
  OUTPUT:
    RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/grok
##----------------------------------------------------------------------

UV
grok_number(string)
	SV *string
	PREINIT:
		const char *pv;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		if (!grok_number(pv, len, &RETVAL))
		  XSRETURN_UNDEF;
	OUTPUT:
		RETVAL

UV
grok_bin(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = grok_bin(pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
grok_hex(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = grok_hex(pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
grok_oct(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = grok_oct(pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
Perl_grok_number(string)
	SV *string
	PREINIT:
		const char *pv;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
		  XSRETURN_UNDEF;
	OUTPUT:
		RETVAL

UV
Perl_grok_bin(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
Perl_grok_hex(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
Perl_grok_oct(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/limits
##----------------------------------------------------------------------

IV
iv_size()
	CODE:
		RETVAL = IVSIZE == sizeof(IV);
	OUTPUT:
		RETVAL

IV
uv_size()
	CODE:
		RETVAL = UVSIZE == sizeof(UV);
	OUTPUT:
		RETVAL

IV
iv_type()
	CODE:
		RETVAL = sizeof(IVTYPE) == sizeof(IV);
	OUTPUT:
		RETVAL

IV
uv_type()
	CODE:
		RETVAL = sizeof(UVTYPE) == sizeof(UV);
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/magic
##----------------------------------------------------------------------

void
sv_catpv_mg(sv, string)
	SV *sv;
	char *string;
	CODE:
		sv_catpv_mg(sv, string);

void
sv_catpvn_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	PREINIT:
		char *str;
		STRLEN len;
	CODE:
		str = SvPV(sv2, len);
		sv_catpvn_mg(sv, str, len);

void
sv_catsv_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	CODE:
		sv_catsv_mg(sv, sv2);

void
sv_setiv_mg(sv, iv)
	SV *sv;
	IV iv;
	CODE:
		sv_setiv_mg(sv, iv);

void
sv_setnv_mg(sv, nv)
	SV *sv;
	NV nv;
	CODE:
		sv_setnv_mg(sv, nv);

void
sv_setpv_mg(sv, pv)
	SV *sv;
	char *pv;
	CODE:
		sv_setpv_mg(sv, pv);

void
sv_setpvn_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	PREINIT:
		char *str;
		STRLEN len;
	CODE:
		str = SvPV(sv2, len);
		sv_setpvn_mg(sv, str, len);

void
sv_setsv_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	CODE:
		sv_setsv_mg(sv, sv2);

void
sv_setuv_mg(sv, uv)
	SV *sv;
	UV uv;
	CODE:
		sv_setuv_mg(sv, uv);

void
sv_usepvn_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	PREINIT:
		char *str, *copy;
		STRLEN len;
	CODE:
		str = SvPV(sv2, len);
		New(42, copy, len+1, char);
		Copy(str, copy, len+1, char);
		sv_usepvn_mg(sv, copy, len);

int
SvVSTRING_mg(sv)
	SV *sv;
	CODE:
		RETVAL = SvVSTRING_mg(sv) != NULL;
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/memory
##----------------------------------------------------------------------

int
checkmem()
  PREINIT:
    char *p;

  CODE:
    RETVAL = 0;
    Newx(p, 6, char);
    CopyD("Hello", p, 6, char);
    if (memEQ(p, "Hello", 6))
      RETVAL++;
    ZeroD(p, 6, char);
    if (memEQ(p, "\0\0\0\0\0\0", 6))
      RETVAL++;
    Poison(p, 6, char);
    if (memNE(p, "\0\0\0\0\0\0", 6))
      RETVAL++;
    Safefree(p);

    Newxz(p, 6, char);
    if (memEQ(p, "\0\0\0\0\0\0", 6))
      RETVAL++;
    Safefree(p);

    Newxc(p, 3, short, char);
    Safefree(p);

  OUTPUT:
    RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/misc
##----------------------------------------------------------------------

int
gv_stashpvn(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
	OUTPUT:
		RETVAL

int
get_sv(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = get_sv(name, create) != NULL;
	OUTPUT:
		RETVAL

int
get_av(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = get_av(name, create) != NULL;
	OUTPUT:
		RETVAL

int
get_hv(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = get_hv(name, create) != NULL;
	OUTPUT:
		RETVAL

int
get_cv(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = get_cv(name, create) != NULL;
	OUTPUT:
		RETVAL

void
newSVpvn()
	PPCODE:
		XPUSHs(newSVpvn("test", 4));
		XPUSHs(newSVpvn("test", 2));
		XPUSHs(newSVpvn("test", 0));
		XPUSHs(newSVpvn(NULL, 2));
		XPUSHs(newSVpvn(NULL, 0));
		XSRETURN(5);

void
xsreturn(two)
	int two
	PPCODE:
		XPUSHs(newSVpvn("test1", 5));
		if (two)
		  XPUSHs(newSVpvn("test2", 5));
		if (two)
		  XSRETURN(2);
		else
		  XSRETURN(1);

SV *
PL_sv_undef()
	CODE:
		RETVAL = newSVsv(&PL_sv_undef);
	OUTPUT:
		RETVAL

SV *
PL_sv_yes()
	CODE:
		RETVAL = newSVsv(&PL_sv_yes);
	OUTPUT:
		RETVAL

SV *
PL_sv_no()
	CODE:
		RETVAL = newSVsv(&PL_sv_no);
	OUTPUT:
		RETVAL

int
PL_na(string)
	char *string
	CODE:
		PL_na = strlen(string);
		RETVAL = PL_na;
	OUTPUT:
		RETVAL

SV*
boolSV(value)
	int value
	CODE:
		RETVAL = newSVsv(boolSV(value));
	OUTPUT:
		RETVAL

SV*
DEFSV()
	CODE:
		RETVAL = newSVsv(DEFSV);
	OUTPUT:
		RETVAL

int
ERRSV()
	CODE:
		RETVAL = SvTRUE(ERRSV);
	OUTPUT:
		RETVAL

SV*
UNDERBAR()
	CODE:
		{
		  dUNDERBAR;
		  RETVAL = newSVsv(UNDERBAR);
		}
	OUTPUT:
		RETVAL

void
prepush()
	CODE:
		{
		  dXSTARG;
		  XSprePUSH;
		  PUSHi(42);
		  XSRETURN(1);
		}

int
PERL_ABS(a)
	int a

void
SVf(x)
	SV *x
	PPCODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		x = newSVpvf("[%"SVf"]", x);
#endif
		XPUSHs(x);
		XSRETURN(1);

##----------------------------------------------------------------------
##  XSUBs from parts/inc/mPUSH
##----------------------------------------------------------------------

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);

##----------------------------------------------------------------------
##  XSUBs from parts/inc/MY_CXT
##----------------------------------------------------------------------

int
MY_CXT_1()
	CODE:
		dMY_CXT;
		RETVAL = MY_CXT.dummy == 42;
		++MY_CXT.dummy;
	OUTPUT:
		RETVAL

int
MY_CXT_2()
	CODE:
		dMY_CXT;
		RETVAL = MY_CXT.dummy == 43;
	OUTPUT:
		RETVAL

int
MY_CXT_CLONE()
	CODE:
		MY_CXT_CLONE;
		RETVAL = 42;
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/newCONSTSUB
##----------------------------------------------------------------------

void
call_newCONSTSUB_1()

void
call_newCONSTSUB_2()

void
call_newCONSTSUB_3()

##----------------------------------------------------------------------
##  XSUBs from parts/inc/newRV
##----------------------------------------------------------------------

U32
newRV_inc_REFCNT()
	PREINIT:
		SV *sv, *rv;
	CODE:
		sv = newSViv(42);
		rv = newRV_inc(sv);
		SvREFCNT_dec(sv);
		RETVAL = SvREFCNT(sv);
		sv_2mortal(rv);
	OUTPUT:
		RETVAL

U32
newRV_noinc_REFCNT()
	PREINIT:
		SV *sv, *rv;
	CODE:
		sv = newSViv(42);
		rv = newRV_noinc(sv);
		RETVAL = SvREFCNT(sv);
		sv_2mortal(rv);
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/pvs
##----------------------------------------------------------------------

void
newSVpvs()
	PPCODE:
		XPUSHs(newSVpvs("newSVpvs"));
		XSRETURN(1);

void
sv_catpvs(sv)
	SV *sv
	PPCODE:
		sv_catpvs(sv, "sv_catpvs");

void
sv_setpvs(sv)
	SV *sv
	PPCODE:
		sv_setpvs(sv, "sv_setpvs");

void
hv_fetchs(hv)
	SV *hv
	PREINIT:
		SV **s;
	PPCODE:
		s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0);
		XPUSHs(sv_mortalcopy(*s));
		XSRETURN(1);

void
hv_stores(hv, sv)
	SV *hv
	SV *sv
	PPCODE:
		hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc(sv));

##----------------------------------------------------------------------
##  XSUBs from parts/inc/snprintf
##----------------------------------------------------------------------

void
my_snprintf()
	PREINIT:
		char buf[128];
		int len;
	PPCODE:
		len = my_snprintf(buf, sizeof buf, "foo%s%d", "bar", 42);
		XPUSHs(newSViv(len));
		XPUSHs(newSVpv(buf, 0));
		XSRETURN(2);

##----------------------------------------------------------------------
##  XSUBs from parts/inc/Sv_set
##----------------------------------------------------------------------

IV
TestSvUV_set(sv, val)
	SV *sv
	UV val
	CODE:
		SvUV_set(sv, val);
		RETVAL = SvUVX(sv) == val ? 42 : -1;
	OUTPUT:
		RETVAL

IV
TestSvPVX_const(sv)
        SV *sv
        CODE:
                RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1;
        OUTPUT:
                RETVAL

IV
TestSvPVX_mutable(sv)
        SV *sv
        CODE:
                RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1;
        OUTPUT:
                RETVAL

void
TestSvSTASH_set(sv, name)
        SV *sv
	char *name
        CODE:
		sv = SvRV(sv);
		SvREFCNT_dec(SvSTASH(sv));
                SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0)));

##----------------------------------------------------------------------
##  XSUBs from parts/inc/sv_xpvf
##----------------------------------------------------------------------

SV *
vnewSVpvf()
	CODE:
		RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
	OUTPUT:
		RETVAL

SV *
sv_vcatpvf(sv)
	SV *sv
	CODE:
		RETVAL = newSVsv(sv);
		test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
	OUTPUT:
		RETVAL

SV *
sv_vsetpvf(sv)
	SV *sv
	CODE:
		RETVAL = newSVsv(sv);
		test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
	OUTPUT:
		RETVAL

void
sv_catpvf_mg(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
#endif

void
Perl_sv_catpvf_mg(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
#endif

void
sv_catpvf_mg_nocontext(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
#ifdef PERL_IMPLICIT_CONTEXT
		sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
#else
		sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
#endif
#endif

void
sv_setpvf_mg(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
#endif

void
Perl_sv_setpvf_mg(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
#endif

void
sv_setpvf_mg_nocontext(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
#ifdef PERL_IMPLICIT_CONTEXT
		sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
#else
		sv_setpvf_mg(sv, "%s-%d", "bar", 44);
#endif
#endif

##----------------------------------------------------------------------
##  XSUBs from parts/inc/SvPV
##----------------------------------------------------------------------

IV
SvPVbyte(sv)
	SV *sv
	PREINIT:
		STRLEN len;
		const char *str;
	CODE:
		str = SvPVbyte(sv, len);
		RETVAL = strEQ(str, "mhx") ? (IV) len : (IV) -1;
	OUTPUT:
		RETVAL

IV
SvPV_nolen(sv)
	SV *sv
	PREINIT:
		const char *str;
	CODE:
		str = SvPV_nolen(sv);
		RETVAL = strEQ(str, "mhx") ? 42 : 0;
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/SvREFCNT
##----------------------------------------------------------------------

void
SvREFCNT()
	PREINIT:
		SV *sv, *svr;
	PPCODE:
		sv = newSV(0);
		XPUSHs(newSViv(SvREFCNT(sv) == 1));
		svr = SvREFCNT_inc(sv);
		XPUSHs(newSViv(sv == svr));
		XPUSHs(newSViv(SvREFCNT(sv) == 2));
		svr = SvREFCNT_inc_simple(sv);
		XPUSHs(newSViv(sv == svr));
		XPUSHs(newSViv(SvREFCNT(sv) == 3));
		svr = SvREFCNT_inc_NN(sv);
		XPUSHs(newSViv(sv == svr));
		XPUSHs(newSViv(SvREFCNT(sv) == 4));
		svr = SvREFCNT_inc_simple_NN(sv);
		XPUSHs(newSViv(sv == svr));
		XPUSHs(newSViv(SvREFCNT(sv) == 5));
		SvREFCNT_inc_void(sv);
		XPUSHs(newSViv(SvREFCNT(sv) == 6));
		SvREFCNT_inc_simple_void(sv);
		XPUSHs(newSViv(SvREFCNT(sv) == 7));
		SvREFCNT_inc_void_NN(sv);
		XPUSHs(newSViv(SvREFCNT(sv) == 8));
		SvREFCNT_inc_simple_void_NN(sv);
		XPUSHs(newSViv(SvREFCNT(sv) == 9));
		while (SvREFCNT(sv) > 1)
		  SvREFCNT_dec(sv);
		XPUSHs(newSViv(SvREFCNT(sv) == 1));
		SvREFCNT_dec(sv);
		XSRETURN(14);

##----------------------------------------------------------------------
##  XSUBs from parts/inc/threads
##----------------------------------------------------------------------

IV
no_THX_arg(sv)
	SV *sv
	CODE:
		RETVAL = 1 + sv_2iv(sv);
	OUTPUT:
		RETVAL

void
with_THX_arg(error)
	char *error
	PPCODE:
		Perl_croak(aTHX_ "%s", error);

##----------------------------------------------------------------------
##  XSUBs from parts/inc/uv
##----------------------------------------------------------------------

SV *
sv_setuv(uv)
	UV uv
	CODE:
		RETVAL = newSViv(1);
		sv_setuv(RETVAL, uv);
	OUTPUT:
		RETVAL

SV *
newSVuv(uv)
	UV uv
	CODE:
		RETVAL = newSVuv(uv);
	OUTPUT:
		RETVAL

UV
sv_2uv(sv)
	SV *sv
	CODE:
		RETVAL = sv_2uv(sv);
	OUTPUT:
		RETVAL

UV
SvUVx(sv)
	SV *sv
	CODE:
		sv--;
		RETVAL = SvUVx(++sv);
	OUTPUT:
		RETVAL

void
XSRETURN_UV()
	PPCODE:
		XSRETURN_UV(42);

void
PUSHu()
	PREINIT:
		dTARG;
	PPCODE:
		TARG = sv_newmortal();
		EXTEND(SP, 1);
		PUSHu(42);
		XSRETURN(1);

void
XPUSHu()
	PREINIT:
		dTARG;
	PPCODE:
		TARG = sv_newmortal();
		XPUSHu(43);
		XSRETURN(1);

##----------------------------------------------------------------------
##  XSUBs from parts/inc/variables
##----------------------------------------------------------------------

int
compare_PL_signals()
	CODE:
		{
		  U32 ref = get_PL_signals_1();
		  RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
		}
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/warn
##----------------------------------------------------------------------

void
warner()
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42);
#endif

void
Perl_warner()
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42);
#endif

void
Perl_warner_nocontext()
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		Perl_warner_nocontext(packWARN(WARN_MISC), "Perl_warner_nocontext %s:%d", "bar", 42);
#endif

void
ckWARN()
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		if (ckWARN(WARN_MISC))
		  Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42);
#endif