[p5sagit/p5-mst-13.2.git] / ext / XS / APItest / APItest.xs

#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(void)
{
#ifdef PERL_IMPLICIT_CONTEXT
    dTHX;
    dMY_CXT_INTERP(my_perl);
#else
    dMY_CXT;
#endif
    return MY_CXT.sv;
}

void
my_cxt_setsv_p(SV* sv _pMY_CXT)
{
    MY_CXT.sv = sv;
}


/* from exception.c */
int 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);
}

MODULE = XS::APItest:Hash		PACKAGE = XS::APItest::Hash

#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

SV *
delete(hash, key_sv)
	PREINIT:
	STRLEN len;
	const char *key;
	INPUT:
	HV *hash
	SV *key_sv
	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), 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(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

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

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
	
	
=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
        CODE:
        printf("%5.3f\n",val);

int
have_long_double()
        CODE:
#ifdef HAS_LONG_DOUBLE
        RETVAL = 1;
#else
        RETVAL = 0;
#endif
        OUTPUT:
        RETVAL

void
print_long_double()
        CODE:
#ifdef HAS_LONG_DOUBLE
#   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
        long double val = 7.0;
        printf("%5.3" PERL_PRIfldbl "\n",val);
#   else
        double val = 7.0;
        printf("%5.3f\n",val);
#   endif
#endif

void
print_int(val)
        int val
        CODE:
        printf("%d\n",val);

void
print_long(val)
        long val
        CODE:
        printf("%ld\n",val);

void
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
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()
    PPCODE:
	EXTEND(SP, 1);
	ST(0) = 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()
Commit	Line	Data
6a93a7e5	1	#define PERL_IN_XS_APITEST
3e61d65a	2	#include "EXTERN.h"
	3	#include "perl.h"
	4	#include "XSUB.h"
	5
85ce96a1	6
	7	/* for my_cxt tests */
	8
	9	#define MY_CXT_KEY "XS::APItest::_guts" XS_VERSION
	10
	11	typedef struct {
	12	int i;
	13	SV *sv;
	14	} my_cxt_t;
	15
	16	START_MY_CXT
	17
	18	/* indirect functions to test the [pa]MY_CXT macros */
f16dd614	19
85ce96a1	20	int
	21	my_cxt_getint_p(pMY_CXT)
	22	{
	23	return MY_CXT.i;
	24	}
f16dd614	25
85ce96a1	26	void
	27	my_cxt_setint_p(pMY_CXT_ int i)
	28	{
	29	MY_CXT.i = i;
	30	}
f16dd614	31
f16dd614	32	SV*
5d477a6d	33	my_cxt_getsv_interp(void)
f16dd614	34	{
	35	#ifdef PERL_IMPLICIT_CONTEXT
	36	dTHX;
	37	dMY_CXT_INTERP(my_perl);
	38	#else
	39	dMY_CXT;
	40	#endif
	41	return MY_CXT.sv;
	42	}
	43
85ce96a1	44	void
	45	my_cxt_setsv_p(SV* sv _pMY_CXT)
	46	{
	47	MY_CXT.sv = sv;
	48	}
	49
	50
9b5c3821	51	/* from exception.c */
9b5c3821	52	int exception(int);
0314122a	53
ff66e713	54	/* from core_or_not.inc */
	55	bool sv_setsv_cow_hashkey_core(void);
	56	bool sv_setsv_cow_hashkey_notcore(void);
	57
2dc92170	58	/* A routine to test hv_delayfree_ent
	59	(which itself is tested by testing on hv_free_ent */
	60
	61	typedef void (freeent_function)(pTHX_ HV , register HE );
	62
	63	void
	64	test_freeent(freeent_function *f) {
	65	dTHX;
	66	dSP;
	67	HV *test_hash = newHV();
	68	HE *victim;
	69	SV *test_scalar;
	70	U32 results[4];
	71	int i;
	72
8afd2d2e	73	#ifdef PURIFY
	74	victim = (HE*)safemalloc(sizeof(HE));
	75	#else
2dc92170	76	/* Storing then deleting something should ensure that a hash entry is
	77	available. */
	78	hv_store(test_hash, "", 0, &PL_sv_yes, 0);
	79	hv_delete(test_hash, "", 0, 0);
	80
	81	/* We need to "inline" new_he here as it's static, and the functions we
	82	test expect to be able to call del_HE on the HE */
6a93a7e5	83	if (!PL_body_roots[HE_SVSLOT])
2dc92170	84	croak("PL_he_root is 0");
8a722a80	85	victim = (HE*) PL_body_roots[HE_SVSLOT];
6a93a7e5	86	PL_body_roots[HE_SVSLOT] = HeNEXT(victim);
8afd2d2e	87	#endif
2dc92170	88
	89	victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
	90
	91	test_scalar = newSV(0);
	92	SvREFCNT_inc(test_scalar);
de616631	93	HeVAL(victim) = test_scalar;
2dc92170	94
	95	/* Need this little game else we free the temps on the return stack. */
	96	results[0] = SvREFCNT(test_scalar);
	97	SAVETMPS;
	98	results[1] = SvREFCNT(test_scalar);
	99	f(aTHX_ test_hash, victim);
	100	results[2] = SvREFCNT(test_scalar);
	101	FREETMPS;
	102	results[3] = SvREFCNT(test_scalar);
	103
	104	i = 0;
	105	do {
	106	mPUSHu(results[i]);
	107	} while (++i < sizeof(results)/sizeof(results[0]));
	108
	109	/* Goodbye to our extra reference. */
	110	SvREFCNT_dec(test_scalar);
	111	}
	112
0314122a	113	MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
0314122a	114
028f8eaa	115	#define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len)
028f8eaa	116
0314122a	117	bool
	118	exists(hash, key_sv)
	119	PREINIT:
	120	STRLEN len;
	121	const char *key;
	122	INPUT:
	123	HV *hash
	124	SV *key_sv
	125	CODE:
	126	key = SvPV(key_sv, len);
028f8eaa	127	RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
0314122a	128	OUTPUT:
	129	RETVAL
	130
b60cf05a	131	SV *
	132	delete(hash, key_sv)
	133	PREINIT:
	134	STRLEN len;
	135	const char *key;
	136	INPUT:
	137	HV *hash
	138	SV *key_sv
	139	CODE:
	140	key = SvPV(key_sv, len);
	141	/* It's already mortal, so need to increase reference count. */
028f8eaa	142	RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
b60cf05a	143	OUTPUT:
	144	RETVAL
	145
	146	SV *
858117f8	147	store_ent(hash, key, value)
	148	PREINIT:
	149	SV *copy;
	150	HE *result;
	151	INPUT:
	152	HV *hash
	153	SV *key
	154	SV *value
	155	CODE:
	156	copy = newSV(0);
	157	result = hv_store_ent(hash, key, copy, 0);
	158	SvSetMagicSV(copy, value);
	159	if (!result) {
	160	SvREFCNT_dec(copy);
	161	XSRETURN_EMPTY;
	162	}
	163	/* It's about to become mortal, so need to increase reference count.
	164	*/
	165	RETVAL = SvREFCNT_inc(HeVAL(result));
	166	OUTPUT:
	167	RETVAL
	168
	169
	170	SV *
b60cf05a	171	store(hash, key_sv, value)
	172	PREINIT:
	173	STRLEN len;
	174	const char *key;
	175	SV *copy;
	176	SV **result;
	177	INPUT:
	178	HV *hash
	179	SV *key_sv
	180	SV *value
	181	CODE:
	182	key = SvPV(key_sv, len);
	183	copy = newSV(0);
028f8eaa	184	result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
858117f8	185	SvSetMagicSV(copy, value);
b60cf05a	186	if (!result) {
	187	SvREFCNT_dec(copy);
	188	XSRETURN_EMPTY;
	189	}
	190	/* It's about to become mortal, so need to increase reference count.
	191	*/
	192	RETVAL = SvREFCNT_inc(*result);
	193	OUTPUT:
	194	RETVAL
	195
	196
	197	SV *
	198	fetch(hash, key_sv)
	199	PREINIT:
	200	STRLEN len;
	201	const char *key;
	202	SV **result;
	203	INPUT:
	204	HV *hash
	205	SV *key_sv
	206	CODE:
	207	key = SvPV(key_sv, len);
028f8eaa	208	result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
b60cf05a	209	if (!result) {
	210	XSRETURN_EMPTY;
	211	}
	212	/* Force mg_get */
	213	RETVAL = newSVsv(*result);
	214	OUTPUT:
	215	RETVAL
2dc92170	216
439efdfe	217	void
2dc92170	218	test_hv_free_ent()
	219	PPCODE:
	220	test_freeent(&Perl_hv_free_ent);
	221	XSRETURN(4);
	222
439efdfe	223	void
2dc92170	224	test_hv_delayfree_ent()
	225	PPCODE:
	226	test_freeent(&Perl_hv_delayfree_ent);
	227	XSRETURN(4);
35ab5632	228
	229	SV *
	230	test_share_unshare_pvn(input)
	231	PREINIT:
35ab5632	232	STRLEN len;
	233	U32 hash;
	234	char *pvx;
	235	char *p;
	236	INPUT:
	237	SV *input
	238	CODE:
	239	pvx = SvPV(input, len);
	240	PERL_HASH(hash, pvx, len);
	241	p = sharepvn(pvx, len, hash);
	242	RETVAL = newSVpvn(p, len);
	243	unsharepvn(p, len, hash);
	244	OUTPUT:
	245	RETVAL
d8c5b3c5	246
	247	bool
	248	refcounted_he_exists(key, level=0)
	249	SV *key
	250	IV level
	251	CODE:
	252	if (level) {
	253	croak("level must be zero, not %"IVdf, level);
	254	}
	255	RETVAL = (Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
	256	key, NULL, 0, 0, 0)
	257	!= &PL_sv_placeholder);
	258	OUTPUT:
	259	RETVAL
	260
	261
	262	SV *
	263	refcounted_he_fetch(key, level=0)
	264	SV *key
	265	IV level
	266	CODE:
	267	if (level) {
	268	croak("level must be zero, not %"IVdf, level);
	269	}
	270	RETVAL = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, key,
	271	NULL, 0, 0, 0);
	272	SvREFCNT_inc(RETVAL);
	273	OUTPUT:
	274	RETVAL
	275
35ab5632	276
0314122a	277	=pod
	278
	279	sub TIEHASH { bless {}, $_[0] }
	280	sub STORE { $_[0]->{$_[1]} = $_[2] }
	281	sub FETCH { $_[0]->{$_[1]} }
	282	sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
	283	sub NEXTKEY { each %{$_[0]} }
	284	sub EXISTS { exists $_[0]->{$_[1]} }
	285	sub DELETE { delete $_[0]->{$_[1]} }
	286	sub CLEAR { %{$_[0]} = () }
	287
	288	=cut
	289
3e61d65a	290	MODULE = XS::APItest PACKAGE = XS::APItest
	291
	292	PROTOTYPES: DISABLE
	293
85ce96a1	294	BOOT:
	295	{
	296	MY_CXT_INIT;
	297	MY_CXT.i = 99;
	298	MY_CXT.sv = newSVpv("initial",0);
	299	}
	300
	301	void
	302	CLONE(...)
	303	CODE:
	304	MY_CXT_CLONE;
	305	MY_CXT.sv = newSVpv("initial_clone",0);
	306
3e61d65a	307	void
	308	print_double(val)
	309	double val
	310	CODE:
	311	printf("%5.3f\n",val);
	312
	313	int
	314	have_long_double()
	315	CODE:
	316	#ifdef HAS_LONG_DOUBLE
	317	RETVAL = 1;
	318	#else
	319	RETVAL = 0;
	320	#endif
cabb36f0	321	OUTPUT:
cabb36f0	322	RETVAL
3e61d65a	323
	324	void
	325	print_long_double()
	326	CODE:
	327	#ifdef HAS_LONG_DOUBLE
fc0bf671	328	# if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
3e61d65a	329	long double val = 7.0;
	330	printf("%5.3" PERL_PRIfldbl "\n",val);
	331	# else
	332	double val = 7.0;
	333	printf("%5.3f\n",val);
	334	# endif
	335	#endif
	336
	337	void
3e61d65a	338	print_int(val)
	339	int val
	340	CODE:
	341	printf("%d\n",val);
	342
	343	void
	344	print_long(val)
	345	long val
	346	CODE:
	347	printf("%ld\n",val);
	348
	349	void
	350	print_float(val)
	351	float val
	352	CODE:
	353	printf("%5.3f\n",val);
9d911683	354
	355	void
	356	print_flush()
	357	CODE:
	358	fflush(stdout);
d4b90eee	359
	360	void
	361	mpushp()
	362	PPCODE:
	363	EXTEND(SP, 3);
	364	mPUSHp("one", 3);
	365	mPUSHp("two", 3);
	366	mPUSHp("three", 5);
	367	XSRETURN(3);
	368
	369	void
	370	mpushn()
	371	PPCODE:
	372	EXTEND(SP, 3);
	373	mPUSHn(0.5);
	374	mPUSHn(-0.25);
	375	mPUSHn(0.125);
	376	XSRETURN(3);
	377
	378	void
	379	mpushi()
	380	PPCODE:
	381	EXTEND(SP, 3);
d75b63cf	382	mPUSHi(-1);
	383	mPUSHi(2);
	384	mPUSHi(-3);
d4b90eee	385	XSRETURN(3);
	386
	387	void
	388	mpushu()
	389	PPCODE:
	390	EXTEND(SP, 3);
d75b63cf	391	mPUSHu(1);
	392	mPUSHu(2);
	393	mPUSHu(3);
d4b90eee	394	XSRETURN(3);
	395
	396	void
	397	mxpushp()
	398	PPCODE:
	399	mXPUSHp("one", 3);
	400	mXPUSHp("two", 3);
	401	mXPUSHp("three", 5);
	402	XSRETURN(3);
	403
	404	void
	405	mxpushn()
	406	PPCODE:
	407	mXPUSHn(0.5);
	408	mXPUSHn(-0.25);
	409	mXPUSHn(0.125);
	410	XSRETURN(3);
	411
	412	void
	413	mxpushi()
	414	PPCODE:
d75b63cf	415	mXPUSHi(-1);
	416	mXPUSHi(2);
	417	mXPUSHi(-3);
d4b90eee	418	XSRETURN(3);
	419
	420	void
	421	mxpushu()
	422	PPCODE:
d75b63cf	423	mXPUSHu(1);
	424	mXPUSHu(2);
	425	mXPUSHu(3);
d4b90eee	426	XSRETURN(3);
d1f347d7	427
	428
	429	void
	430	call_sv(sv, flags, ...)
	431	SV* sv
	432	I32 flags
	433	PREINIT:
	434	I32 i;
	435	PPCODE:
	436	for (i=0; i<items-2; i++)
	437	ST(i) = ST(i+2); /* pop first two args */
	438	PUSHMARK(SP);
	439	SP += items - 2;
	440	PUTBACK;
	441	i = call_sv(sv, flags);
	442	SPAGAIN;
	443	EXTEND(SP, 1);
	444	PUSHs(sv_2mortal(newSViv(i)));
	445
	446	void
	447	call_pv(subname, flags, ...)
	448	char* subname
	449	I32 flags
	450	PREINIT:
	451	I32 i;
	452	PPCODE:
	453	for (i=0; i<items-2; i++)
	454	ST(i) = ST(i+2); /* pop first two args */
	455	PUSHMARK(SP);
	456	SP += items - 2;
	457	PUTBACK;
	458	i = call_pv(subname, flags);
	459	SPAGAIN;
	460	EXTEND(SP, 1);
	461	PUSHs(sv_2mortal(newSViv(i)));
	462
	463	void
	464	call_method(methname, flags, ...)
	465	char* methname
	466	I32 flags
	467	PREINIT:
	468	I32 i;
	469	PPCODE:
	470	for (i=0; i<items-2; i++)
	471	ST(i) = ST(i+2); /* pop first two args */
	472	PUSHMARK(SP);
	473	SP += items - 2;
	474	PUTBACK;
	475	i = call_method(methname, flags);
	476	SPAGAIN;
	477	EXTEND(SP, 1);
	478	PUSHs(sv_2mortal(newSViv(i)));
	479
	480	void
	481	eval_sv(sv, flags)
	482	SV* sv
	483	I32 flags
	484	PREINIT:
	485	I32 i;
	486	PPCODE:
	487	PUTBACK;
	488	i = eval_sv(sv, flags);
	489	SPAGAIN;
	490	EXTEND(SP, 1);
491	PUSHs(sv_2mortal(newSViv(i)));
492
b8e65a9b	493	void
d1f347d7	494	eval_pv(p, croak_on_error)
	495	const char* p
	496	I32 croak_on_error
d1f347d7	497	PPCODE:
	498	PUTBACK;
	499	EXTEND(SP, 1);
	500	PUSHs(eval_pv(p, croak_on_error));
	501
	502	void
	503	require_pv(pv)
	504	const char* pv
d1f347d7	505	PPCODE:
	506	PUTBACK;
	507	require_pv(pv);
	508
0ca3a874	509	int
	510	exception(throw_e)
	511	int throw_e
	512	OUTPUT:
	513	RETVAL
d1f347d7	514
ef469b03	515	void
7e7a3dfc	516	mycroak(sv)
7e7a3dfc	517	SV* sv
ef469b03	518	CODE:
7e7a3dfc	519	if (SvOK(sv)) {
	520	Perl_croak(aTHX_ "%s", SvPV_nolen(sv));
	521	}
	522	else {
	523	Perl_croak(aTHX_ NULL);
	524	}
5d2b1485	525
	526	SV*
	527	strtab()
	528	CODE:
	529	RETVAL = newRV_inc((SV*)PL_strtab);
	530	OUTPUT:
	531	RETVAL
85ce96a1	532
	533	int
	534	my_cxt_getint()
	535	CODE:
	536	dMY_CXT;
	537	RETVAL = my_cxt_getint_p(aMY_CXT);
	538	OUTPUT:
	539	RETVAL
	540
	541	void
	542	my_cxt_setint(i)
	543	int i;
	544	CODE:
	545	dMY_CXT;
	546	my_cxt_setint_p(aMY_CXT_ i);
	547
	548	void
	549	my_cxt_getsv()
	550	PPCODE:
85ce96a1	551	EXTEND(SP, 1);
f16dd614	552	ST(0) = my_cxt_getsv_interp();
85ce96a1	553	XSRETURN(1);
	554
	555	void
	556	my_cxt_setsv(sv)
	557	SV *sv;
	558	CODE:
	559	dMY_CXT;
	560	SvREFCNT_dec(MY_CXT.sv);
	561	my_cxt_setsv_p(sv _aMY_CXT);
	562	SvREFCNT_inc(sv);
34482cd6	563
	564	bool
	565	sv_setsv_cow_hashkey_core()
	566
	567	bool
	568	sv_setsv_cow_hashkey_notcore()