[perl5.git] / ext / Devel / PPPort / parts / inc / misc

################################################################################
##
##  $Revision: 38 $
##  $Author: mhx $
##  $Date: 2007/01/02 12:32:34 +0100 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2007, 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
PTR2IV
PTR2UV
PTR2NV
PTR2ul
START_EXTERN_C
END_EXTERN_C
EXTERN_C
STMT_START
STMT_END
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)

__UNDEFINED__  newSVpvn(data,len)  ((data)                                              \
                                    ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
                                    : newSV(0))

/* 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             "_"

=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;
  PUSHs(sv_2mortal(newSViv(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
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*
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 { VERSION >= 5.004 }
		x = newSVpvf("[%"SVf"]", x);
#endif
		XPUSHs(x);
		XSRETURN(1);

=tests plan => 38

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

my @s = &Devel::PPPort::newSVpvn();
ok(@s == 5);
ok($s[0], "test");
ok($s[1], "te");
ok($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));

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