[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / parts / inc / misc

################################################################################
##
##  $Revision: 44 $
##  $Author: mhx $
##  $Date: 2008/01/04 14:54:43 +0100 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2008, 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.
##
################################################################################

=provides

__UNDEFINED__
PERL_UNUSED_DECL
PERL_UNUSED_ARG
PERL_UNUSED_VAR
PERL_UNUSED_CONTEXT
PERL_GCC_BRACE_GROUPS_FORBIDDEN
PERL_USE_GCC_BRACE_GROUPS
NVTYPE
INT2PTR
PTRV
NUM2PTR
PERL_HASH
PTR2IV
PTR2UV
PTR2NV
PTR2ul
START_EXTERN_C
END_EXTERN_C
EXTERN_C
STMT_START
STMT_END
UTF8_MAXBYTES
XSRETURN

=implementation

#ifndef PERL_UNUSED_DECL
#  ifdef HASATTRIBUTE
#    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
#      define PERL_UNUSED_DECL
#    else
#      define PERL_UNUSED_DECL __attribute__((unused))
#    endif
#  else
#    define PERL_UNUSED_DECL
#  endif
#endif

#ifndef PERL_UNUSED_ARG
#  if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
#    include <note.h>
#    define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
#  else
#    define PERL_UNUSED_ARG(x) ((void)x)
#  endif
#endif

#ifndef PERL_UNUSED_VAR
#  define PERL_UNUSED_VAR(x) ((void)x)
#endif

#ifndef PERL_UNUSED_CONTEXT
#  ifdef USE_ITHREADS
#    define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
#  else
#    define PERL_UNUSED_CONTEXT
#  endif
#endif

__UNDEFINED__  NOOP          /*EMPTY*/(void)0
__UNDEFINED__  dNOOP         extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL

#ifndef NVTYPE
#  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
#    define NVTYPE long double
#  else
#    define NVTYPE double
#  endif
typedef NVTYPE NV;
#endif

#ifndef INT2PTR

#  if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
#    define PTRV                  UV
#    define INT2PTR(any,d)        (any)(d)
#  else
#    if PTRSIZE == LONGSIZE
#      define PTRV                unsigned long
#    else
#      define PTRV                unsigned
#    endif
#    define INT2PTR(any,d)        (any)(PTRV)(d)
#  endif

#  define NUM2PTR(any,d)  (any)(PTRV)(d)
#  define PTR2IV(p)       INT2PTR(IV,p)
#  define PTR2UV(p)       INT2PTR(UV,p)
#  define PTR2NV(p)       NUM2PTR(NV,p)

#  if PTRSIZE == LONGSIZE
#    define PTR2ul(p)     (unsigned long)(p)
#  else
#    define PTR2ul(p)     INT2PTR(unsigned long,p)
#  endif

#endif /* !INT2PTR */

#undef START_EXTERN_C
#undef END_EXTERN_C
#undef EXTERN_C
#ifdef __cplusplus
#  define START_EXTERN_C extern "C" {
#  define END_EXTERN_C }
#  define EXTERN_C extern "C"
#else
#  define START_EXTERN_C
#  define END_EXTERN_C
#  define EXTERN_C extern
#endif

#if defined(PERL_GCC_PEDANTIC)
#  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
#    define PERL_GCC_BRACE_GROUPS_FORBIDDEN
#  endif
#endif

#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
#  ifndef PERL_USE_GCC_BRACE_GROUPS
#    define PERL_USE_GCC_BRACE_GROUPS
#  endif
#endif

#undef STMT_START
#undef STMT_END
#ifdef PERL_USE_GCC_BRACE_GROUPS
#  define STMT_START	(void)(	/* gcc supports ``({ STATEMENTS; })'' */
#  define STMT_END	)
#else
#  if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
#    define STMT_START	if (1)
#    define STMT_END	else (void)0
#  else
#    define STMT_START	do
#    define STMT_END	while (0)
#  endif
#endif

__UNDEFINED__  boolSV(b)    ((b) ? &PL_sv_yes : &PL_sv_no)

/* DEFSV appears first in 5.004_56 */
__UNDEFINED__  DEFSV	    GvSV(PL_defgv)
__UNDEFINED__  SAVE_DEFSV   SAVESPTR(GvSV(PL_defgv))

/* Older perls (<=5.003) lack AvFILLp */
__UNDEFINED__  AvFILLp      AvFILL

__UNDEFINED__  ERRSV        get_sv("@",FALSE)

/* Hint: gv_stashpvn
 * This function's backport doesn't support the length parameter, but
 * rather ignores it. Portability can only be ensured if the length
 * parameter is used for speed reasons, but the length can always be
 * correctly computed from the string argument.
 */

__UNDEFINED__  gv_stashpvn(str,len,create)  gv_stashpv(str,create)

/* Replace: 1 */
__UNDEFINED__  get_cv          perl_get_cv
__UNDEFINED__  get_sv          perl_get_sv
__UNDEFINED__  get_av          perl_get_av
__UNDEFINED__  get_hv          perl_get_hv
/* Replace: 0 */

__UNDEFINED__  dUNDERBAR       dNOOP
__UNDEFINED__  UNDERBAR        DEFSV

__UNDEFINED__  dAX             I32 ax = MARK - PL_stack_base + 1
__UNDEFINED__  dITEMS          I32 items = SP - MARK

__UNDEFINED__  dXSTARG         SV * targ = sv_newmortal()

__UNDEFINED__  dAXMARK         I32 ax = POPMARK; \
                               register SV ** const mark = PL_stack_base + ax++


__UNDEFINED__  XSprePUSH       (sp = PL_stack_base + ax - 1)

#if { VERSION < 5.005 }
#  undef XSRETURN
#  define XSRETURN(off)                                   \
      STMT_START {                                        \
          PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
          return;                                         \
      } STMT_END
#endif

__UNDEFINED__  PERL_ABS(x)     ((x) < 0 ? -(x) : (x))

__UNDEFINED__  dVAR            dNOOP

__UNDEFINED__  SVf             "_"

__UNDEFINED__  UTF8_MAXBYTES   UTF8_MAXLEN

__UNDEFINED__  PERL_HASH(hash,str,len) \
     STMT_START	{ \
	const char *s_PeRlHaSh = str; \
	I32 i_PeRlHaSh = len; \
	U32 hash_PeRlHaSh = 0; \
	while (i_PeRlHaSh--) \
	    hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
	(hash) = hash_PeRlHaSh; \
    } STMT_END

=xsmisc

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;
  mPUSHi(iv);
  XSRETURN(1);
}

=xsboot

newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);

=xsubs

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
xsreturn(two)
	int two
	PPCODE:
		mXPUSHp("test1", 5);
		if (two)
		  mXPUSHp("test2", 5);
		if (two)
		  XSRETURN(2);
		else
		  XSRETURN(1);

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;
		  mPUSHi(42);
		  XSRETURN(1);
		}

int
PERL_ABS(a)
	int a

void
SVf(x)
	SV *x
	PPCODE:
#if { VERSION >= 5.004 }
		x = sv_2mortal(newSVpvf("[%"SVf"]", x));
#endif
		XPUSHs(x);
		XSRETURN(1);

=tests plan => 32

use vars qw($my_sv @my_av %my_hv);

ok(&Devel::PPPort::boolSV(1));
ok(!&Devel::PPPort::boolSV(0));

$_ = "Fred";
ok(&Devel::PPPort::DEFSV(), "Fred");
ok(&Devel::PPPort::UNDERBAR(), "Fred");

if ($] >= 5.009002) {
  eval q{
    my $_ = "Tony";
    ok(&Devel::PPPort::DEFSV(), "Fred");
    ok(&Devel::PPPort::UNDERBAR(), "Tony");
  };
}
else {
  ok(1);
  ok(1);
}

eval { 1 };
ok(!&Devel::PPPort::ERRSV());
eval { cannot_call_this_one() };
ok(&Devel::PPPort::ERRSV());

ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));

$my_sv = 1;
ok(&Devel::PPPort::get_sv('my_sv', 0));
ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
ok(&Devel::PPPort::get_sv('not_my_sv', 1));

@my_av = (1);
ok(&Devel::PPPort::get_av('my_av', 0));
ok(!&Devel::PPPort::get_av('not_my_av', 0));
ok(&Devel::PPPort::get_av('not_my_av', 1));

%my_hv = (a=>1);
ok(&Devel::PPPort::get_hv('my_hv', 0));
ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
ok(&Devel::PPPort::get_hv('not_my_hv', 1));

sub my_cv { 1 };
ok(&Devel::PPPort::get_cv('my_cv', 0));
ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
ok(&Devel::PPPort::get_cv('not_my_cv', 1));

ok(Devel::PPPort::dXSTARG(42), 43);
ok(Devel::PPPort::dAXMARK(4711), 4710);

ok(Devel::PPPort::prepush(), 42);

ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');

ok(Devel::PPPort::PERL_ABS(42), 42);
ok(Devel::PPPort::PERL_ABS(-13), 13);

ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42');
ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc');
Commit	Line	Data
adfe19db	1	################################################################################
adfe19db	2	##
c1a049cb	3	## $Revision: 44 $
adfe19db	4	## $Author: mhx $
c1a049cb	5	## $Date: 2008/01/04 14:54:43 +0100 $
adfe19db	6	##
	7	################################################################################
	8	##
c1a049cb	9	## Version 3.x, Copyright (C) 2004-2008, Marcus Holland-Moritz.
adfe19db	10	## Version 2.x, Copyright (C) 2001, Paul Marquess.
	11	## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
	12	##
	13	## This program is free software; you can redistribute it and/or
	14	## modify it under the same terms as Perl itself.
	15	##
	16	################################################################################
	17
	18	=provides
	19
	20	__UNDEFINED__
	21	PERL_UNUSED_DECL
f2ab5a41	22	PERL_UNUSED_ARG
	23	PERL_UNUSED_VAR
	24	PERL_UNUSED_CONTEXT
a745474a	25	PERL_GCC_BRACE_GROUPS_FORBIDDEN
c07deaaf	26	PERL_USE_GCC_BRACE_GROUPS
adfe19db	27	NVTYPE
	28	INT2PTR
	29	PTRV
	30	NUM2PTR
c83e6f19	31	PERL_HASH
adfe19db	32	PTR2IV
	33	PTR2UV
	34	PTR2NV
	35	PTR2ul
a745474a	36	START_EXTERN_C
	37	END_EXTERN_C
	38	EXTERN_C
	39	STMT_START
	40	STMT_END
679ad62d	41	UTF8_MAXBYTES
0d0f8426	42	XSRETURN
adfe19db	43
	44	=implementation
	45
62093c1c	46	#ifndef PERL_UNUSED_DECL
	47	# ifdef HASATTRIBUTE
	48	# if (defined(__GNUC__) && defined(__cplusplus)) \|\| defined(__INTEL_COMPILER)
	49	# define PERL_UNUSED_DECL
	50	# else
	51	# define PERL_UNUSED_DECL __attribute__((unused))
	52	# endif
adfe19db	53	# else
62093c1c	54	# define PERL_UNUSED_DECL
adfe19db	55	# endif
adfe19db	56	#endif
adfe19db	57
f2ab5a41	58	#ifndef PERL_UNUSED_ARG
	59	# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
	60	# include <note.h>
	61	# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
	62	# else
	63	# define PERL_UNUSED_ARG(x) ((void)x)
	64	# endif
	65	#endif
	66
	67	#ifndef PERL_UNUSED_VAR
	68	# define PERL_UNUSED_VAR(x) ((void)x)
	69	#endif
	70
	71	#ifndef PERL_UNUSED_CONTEXT
	72	# ifdef USE_ITHREADS
	73	# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
	74	# else
	75	# define PERL_UNUSED_CONTEXT
	76	# endif
	77	#endif
	78
	79	__UNDEFINED__ NOOP /EMPTY/(void)0
	80	__UNDEFINED__ dNOOP extern int /@unused@/ Perl___notused PERL_UNUSED_DECL
adfe19db	81
	82	#ifndef NVTYPE
	83	# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
	84	# define NVTYPE long double
	85	# else
	86	# define NVTYPE double
	87	# endif
	88	typedef NVTYPE NV;
	89	#endif
	90
	91	#ifndef INT2PTR
	92
	93	# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
	94	# define PTRV UV
	95	# define INT2PTR(any,d) (any)(d)
	96	# else
	97	# if PTRSIZE == LONGSIZE
	98	# define PTRV unsigned long
	99	# else
	100	# define PTRV unsigned
	101	# endif
	102	# define INT2PTR(any,d) (any)(PTRV)(d)
	103	# endif
	104
	105	# define NUM2PTR(any,d) (any)(PTRV)(d)
	106	# define PTR2IV(p) INT2PTR(IV,p)
	107	# define PTR2UV(p) INT2PTR(UV,p)
	108	# define PTR2NV(p) NUM2PTR(NV,p)
	109
	110	# if PTRSIZE == LONGSIZE
	111	# define PTR2ul(p) (unsigned long)(p)
	112	# else
4a582685	113	# define PTR2ul(p) INT2PTR(unsigned long,p)
adfe19db	114	# endif
	115
	116	#endif /* !INT2PTR */
	117
a745474a	118	#undef START_EXTERN_C
	119	#undef END_EXTERN_C
	120	#undef EXTERN_C
	121	#ifdef __cplusplus
	122	# define START_EXTERN_C extern "C" {
	123	# define END_EXTERN_C }
	124	# define EXTERN_C extern "C"
	125	#else
	126	# define START_EXTERN_C
	127	# define END_EXTERN_C
	128	# define EXTERN_C extern
	129	#endif
	130
c07deaaf	131	#if defined(PERL_GCC_PEDANTIC)
c07deaaf	132	# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
a745474a	133	# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
	134	# endif
	135	#endif
	136
c07deaaf	137	#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
	138	# ifndef PERL_USE_GCC_BRACE_GROUPS
	139	# define PERL_USE_GCC_BRACE_GROUPS
	140	# endif
	141	#endif
	142
a745474a	143	#undef STMT_START
a745474a	144	#undef STMT_END
c07deaaf	145	#ifdef PERL_USE_GCC_BRACE_GROUPS
a745474a	146	# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
	147	# define STMT_END )
	148	#else
	149	# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) \|\| defined(__sun__)) && !defined(__GNUC__)
	150	# define STMT_START if (1)
	151	# define STMT_END else (void)0
	152	# else
	153	# define STMT_START do
	154	# define STMT_END while (0)
	155	# endif
	156	#endif
	157
adfe19db	158	__UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
	159
	160	/* DEFSV appears first in 5.004_56 */
	161	__UNDEFINED__ DEFSV GvSV(PL_defgv)
	162	__UNDEFINED__ SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
	163
	164	/* Older perls (<=5.003) lack AvFILLp */
	165	__UNDEFINED__ AvFILLp AvFILL
	166
	167	__UNDEFINED__ ERRSV get_sv("@",FALSE)
	168
adfe19db	169	/* Hint: gv_stashpvn
	170	* This function's backport doesn't support the length parameter, but
	171	* rather ignores it. Portability can only be ensured if the length
	172	* parameter is used for speed reasons, but the length can always be
	173	* correctly computed from the string argument.
	174	*/
	175
	176	__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create)
	177
	178	/* Replace: 1 */
	179	__UNDEFINED__ get_cv perl_get_cv
	180	__UNDEFINED__ get_sv perl_get_sv
	181	__UNDEFINED__ get_av perl_get_av
	182	__UNDEFINED__ get_hv perl_get_hv
	183	/* Replace: 0 */
	184
adfe19db	185	__UNDEFINED__ dUNDERBAR dNOOP
	186	__UNDEFINED__ UNDERBAR DEFSV
	187
	188	__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1
	189	__UNDEFINED__ dITEMS I32 items = SP - MARK
	190
9132e1a3	191	__UNDEFINED__ dXSTARG SV * targ = sv_newmortal()
9132e1a3	192
0d0f8426	193	__UNDEFINED__ dAXMARK I32 ax = POPMARK; \
	194	register SV ** const mark = PL_stack_base + ax++
	195
	196
	197	__UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1)
	198
	199	#if { VERSION < 5.005 }
	200	# undef XSRETURN
	201	# define XSRETURN(off) \
	202	STMT_START { \
	203	PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
	204	return; \
	205	} STMT_END
	206	#endif
	207
f2ab5a41	208	__UNDEFINED__ PERL_ABS(x) ((x) < 0 ? -(x) : (x))
	209
	210	__UNDEFINED__ dVAR dNOOP
	211
	212	__UNDEFINED__ SVf "_"
	213
c83e6f19	214	__UNDEFINED__ UTF8_MAXBYTES UTF8_MAXLEN
	215
	216	__UNDEFINED__ PERL_HASH(hash,str,len) \
	217	STMT_START { \
	218	const char *s_PeRlHaSh = str; \
	219	I32 i_PeRlHaSh = len; \
	220	U32 hash_PeRlHaSh = 0; \
	221	while (i_PeRlHaSh--) \
	222	hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
	223	(hash) = hash_PeRlHaSh; \
	224	} STMT_END
679ad62d	225
9132e1a3	226	=xsmisc
	227
	228	XS(XS_Devel__PPPort_dXSTARG); /* prototype */
	229	XS(XS_Devel__PPPort_dXSTARG)
	230	{
	231	dXSARGS;
	232	dXSTARG;
2dd69576	233	IV iv;
9132e1a3	234	SP -= items;
2dd69576	235	iv = SvIV(ST(0)) + 1;
9132e1a3	236	PUSHi(iv);
	237	XSRETURN(1);
	238	}
	239
0d0f8426	240	XS(XS_Devel__PPPort_dAXMARK); /* prototype */
	241	XS(XS_Devel__PPPort_dAXMARK)
	242	{
	243	dSP;
	244	dAXMARK;
	245	dITEMS;
	246	IV iv;
	247	SP -= items;
	248	iv = SvIV(ST(0)) - 1;
c1a049cb	249	mPUSHi(iv);
0d0f8426	250	XSRETURN(1);
	251	}
	252
9132e1a3	253	=xsboot
	254
	255	newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
0d0f8426	256	newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
9132e1a3	257
adfe19db	258	=xsubs
	259
	260	int
	261	gv_stashpvn(name, create)
	262	char *name
	263	I32 create
	264	CODE:
	265	RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
	266	OUTPUT:
	267	RETVAL
	268
	269	int
	270	get_sv(name, create)
	271	char *name
	272	I32 create
	273	CODE:
	274	RETVAL = get_sv(name, create) != NULL;
	275	OUTPUT:
	276	RETVAL
	277
	278	int
	279	get_av(name, create)
	280	char *name
	281	I32 create
	282	CODE:
	283	RETVAL = get_av(name, create) != NULL;
	284	OUTPUT:
	285	RETVAL
	286
	287	int
	288	get_hv(name, create)
	289	char *name
	290	I32 create
	291	CODE:
	292	RETVAL = get_hv(name, create) != NULL;
	293	OUTPUT:
	294	RETVAL
	295
	296	int
	297	get_cv(name, create)
	298	char *name
	299	I32 create
	300	CODE:
	301	RETVAL = get_cv(name, create) != NULL;
	302	OUTPUT:
	303	RETVAL
	304
	305	void
0d0f8426	306	xsreturn(two)
	307	int two
	308	PPCODE:
c1a049cb	309	mXPUSHp("test1", 5);
0d0f8426	310	if (two)
c1a049cb	311	mXPUSHp("test2", 5);
0d0f8426	312	if (two)
	313	XSRETURN(2);
	314	else
	315	XSRETURN(1);
	316
adfe19db	317	SV*
	318	boolSV(value)
	319	int value
	320	CODE:
	321	RETVAL = newSVsv(boolSV(value));
	322	OUTPUT:
	323	RETVAL
	324
	325	SV*
	326	DEFSV()
	327	CODE:
	328	RETVAL = newSVsv(DEFSV);
	329	OUTPUT:
	330	RETVAL
	331
	332	int
	333	ERRSV()
	334	CODE:
	335	RETVAL = SvTRUE(ERRSV);
	336	OUTPUT:
	337	RETVAL
	338
	339	SV*
	340	UNDERBAR()
	341	CODE:
	342	{
	343	dUNDERBAR;
	344	RETVAL = newSVsv(UNDERBAR);
	345	}
	346	OUTPUT:
	347	RETVAL
	348
0d0f8426	349	void
	350	prepush()
	351	CODE:
	352	{
	353	dXSTARG;
	354	XSprePUSH;
c1a049cb	355	mPUSHi(42);
0d0f8426	356	XSRETURN(1);
	357	}
	358
f2ab5a41	359	int
	360	PERL_ABS(a)
	361	int a
	362
	363	void
	364	SVf(x)
	365	SV *x
	366	PPCODE:
	367	#if { VERSION >= 5.004 }
c1a049cb	368	x = sv_2mortal(newSVpvf("[%"SVf"]", x));
f2ab5a41	369	#endif
	370	XPUSHs(x);
	371	XSRETURN(1);
	372
c1a049cb	373	=tests plan => 32
adfe19db	374
	375	use vars qw($my_sv @my_av %my_hv);
	376
adfe19db	377	ok(&Devel::PPPort::boolSV(1));
	378	ok(!&Devel::PPPort::boolSV(0));
	379
	380	$_ = "Fred";
	381	ok(&Devel::PPPort::DEFSV(), "Fred");
	382	ok(&Devel::PPPort::UNDERBAR(), "Fred");
	383
0d0f8426	384	if ($] >= 5.009002) {
	385	eval q{
	386	my $_ = "Tony";
	387	ok(&Devel::PPPort::DEFSV(), "Fred");
	388	ok(&Devel::PPPort::UNDERBAR(), "Tony");
	389	};
	390	}
	391	else {
	392	ok(1);
	393	ok(1);
	394	}
	395
adfe19db	396	eval { 1 };
	397	ok(!&Devel::PPPort::ERRSV());
	398	eval { cannot_call_this_one() };
	399	ok(&Devel::PPPort::ERRSV());
	400
	401	ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
	402	ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
	403	ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
	404
	405	$my_sv = 1;
	406	ok(&Devel::PPPort::get_sv('my_sv', 0));
	407	ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
	408	ok(&Devel::PPPort::get_sv('not_my_sv', 1));
	409
	410	@my_av = (1);
	411	ok(&Devel::PPPort::get_av('my_av', 0));
	412	ok(!&Devel::PPPort::get_av('not_my_av', 0));
	413	ok(&Devel::PPPort::get_av('not_my_av', 1));
	414
	415	%my_hv = (a=>1);
	416	ok(&Devel::PPPort::get_hv('my_hv', 0));
	417	ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
	418	ok(&Devel::PPPort::get_hv('not_my_hv', 1));
	419
	420	sub my_cv { 1 };
	421	ok(&Devel::PPPort::get_cv('my_cv', 0));
	422	ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
	423	ok(&Devel::PPPort::get_cv('not_my_cv', 1));
	424
9132e1a3	425	ok(Devel::PPPort::dXSTARG(42), 43);
0d0f8426	426	ok(Devel::PPPort::dAXMARK(4711), 4710);
	427
	428	ok(Devel::PPPort::prepush(), 42);
9132e1a3	429
0d0f8426	430	ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
0d0f8426	431	ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
f2ab5a41	432
	433	ok(Devel::PPPort::PERL_ABS(42), 42);
	434	ok(Devel::PPPort::PERL_ABS(-13), 13);
	435
	436	ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42');
	437	ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc');
	438