File Coverage

RealPPPort.xs

Criterion	Covered	Total	%
statement	739	753	98.1
branch	565	988	57.1
condition			n/a
subroutine			n/a
pod			n/a
total	1304	1741	74.9

line	stmt	bran	code
1			/*******************************************************************************
2			*
3			* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
4			*
5			* This file was automatically generated from the definition files in the
6			* parts/inc/ subdirectory by PPPort_xs.PL. To learn more about how all this
7			* works, please read the F file that came with this distribution.
8			*
9			********************************************************************************
10			*
11			* Perl/Pollution/Portability
12			*
13			********************************************************************************
14			*
15			* Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
16			* Version 2.x, Copyright (C) 2001, Paul Marquess.
17			* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
18			*
19			* This program is free software; you can redistribute it and/or
20			* modify it under the same terms as Perl itself.
21			*
22			*******************************************************************************/
23
24			/* ========== BEGIN XSHEAD ================================================== */
25
26			#define PERL_NO_GET_CONTEXT
27
28			/* =========== END XSHEAD =================================================== */
29
30			#include "EXTERN.h"
31			#include "perl.h"
32			#include "XSUB.h"
33
34			/* ========== BEGIN XSINIT ================================================== */
35
36			/* ---- code from parts/inc/SvPV ---- */
37			#define NEED_sv_2pv_flags
38			#define NEED_sv_pvn_force_flags
39			#define NEED_sv_2pvbyte
40
41			/* ---- code from parts/inc/call ---- */
42			#define NEED_eval_pv
43			#define NEED_load_module
44			#define NEED_vload_module
45
46			/* ---- code from parts/inc/cop ---- */
47			#define NEED_caller_cx
48
49			/* ---- code from parts/inc/grok ---- */
50			#define NEED_grok_number
51			#define NEED_grok_numeric_radix
52			#define NEED_grok_bin
53			#define NEED_grok_hex
54			#define NEED_grok_oct
55
56			/* ---- code from parts/inc/gv ---- */
57			#define NEED_gv_fetchpvn_flags
58
59			/* ---- code from parts/inc/magic ---- */
60			#define NEED_mg_findext
61			#define NEED_sv_unmagicext
62
63			#ifndef STATIC
64			#define STATIC static
65			#endif
66
67			STATIC MGVTBL null_mg_vtbl = {
68			NULL, /* get */
69			NULL, /* set */
70			NULL, /* len */
71			NULL, /* clear */
72			NULL, /* free */
73			#if MGf_COPY
74			NULL, /* copy */
75			#endif /* MGf_COPY */
76			#if MGf_DUP
77			NULL, /* dup */
78			#endif /* MGf_DUP */
79			#if MGf_LOCAL
80			NULL, /* local */
81			#endif /* MGf_LOCAL */
82			};
83
84			STATIC MGVTBL other_mg_vtbl = {
85			NULL, /* get */
86			NULL, /* set */
87			NULL, /* len */
88			NULL, /* clear */
89			NULL, /* free */
90			#if MGf_COPY
91			NULL, /* copy */
92			#endif /* MGf_COPY */
93			#if MGf_DUP
94			NULL, /* dup */
95			#endif /* MGf_DUP */
96			#if MGf_LOCAL
97			NULL, /* local */
98			#endif /* MGf_LOCAL */
99			};
100
101			/* ---- code from parts/inc/mess ---- */
102			#define NEED_die_sv
103			#define NEED_mess_sv
104			#define NEED_croak_xs_usage
105
106			/* ---- code from parts/inc/misc ---- */
107			#define NEED_SvRX
108
109			/* ---- code from parts/inc/newCONSTSUB ---- */
110			#define NEED_newCONSTSUB
111
112			/* ---- code from parts/inc/newRV ---- */
113			#define NEED_newRV_noinc
114
115			/* ---- code from parts/inc/newSV_type ---- */
116			#define NEED_newSV_type
117
118			/* ---- code from parts/inc/newSVpv ---- */
119			#define NEED_newSVpvn_flags
120
121			/* ---- code from parts/inc/pv_tools ---- */
122			#define NEED_pv_escape
123			#define NEED_pv_pretty
124			#define NEED_pv_display
125
126			/* ---- code from parts/inc/pvs ---- */
127			#define NEED_newSVpvn_share
128
129			/* ---- code from parts/inc/shared_pv ---- */
130			#define NEED_newSVpvn_share
131
132			/* ---- code from parts/inc/snprintf ---- */
133			#define NEED_my_snprintf
134
135			/* ---- code from parts/inc/sprintf ---- */
136			#define NEED_my_sprintf
137
138			/* ---- code from parts/inc/strlfuncs ---- */
139			#define NEED_my_strlcat
140			#define NEED_my_strlcpy
141
142			/* ---- code from parts/inc/sv_xpvf ---- */
143			#define NEED_vnewSVpvf
144			#define NEED_sv_catpvf_mg
145			#define NEED_sv_catpvf_mg_nocontext
146			#define NEED_sv_setpvf_mg
147			#define NEED_sv_setpvf_mg_nocontext
148
149			/* ---- code from parts/inc/uv ---- */
150			#define NEED_my_strnlen
151			#define NEED_utf8_to_uvchr_buf
152
153			/* ---- code from parts/inc/variables ---- */
154			#define NEED_PL_signals
155			#define NEED_PL_parser
156			#define DPPP_PL_parser_NO_DUMMY_WARNING
157
158			/* ---- code from parts/inc/warn ---- */
159			#define NEED_warner
160
161			/* =========== END XSINIT =================================================== */
162
163			#include "ppport.h"
164
165			/* ========== BEGIN XSMISC ================================================== */
166
167			/* ---- code from parts/inc/MY_CXT ---- */
168			#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
169
170			typedef struct {
171			/* Put Global Data in here */
172			int dummy;
173			} my_cxt_t;
174
175			START_MY_CXT
176
177			/* ---- code from parts/inc/exception ---- */
178			/* defined in module3.c */
179			int exception(int throw_e);
180
181			/* ---- code from parts/inc/misc ---- */
182			typedef XSPROTO(XSPROTO_test_t);
183			typedef XSPROTO_test_t *XSPROTO_test_t_ptr;
184
185			XS(XS_Devel__PPPort_dXSTARG); /* prototype */
186	1		XS(XS_Devel__PPPort_dXSTARG)
187			{
188	1		dXSARGS;
189	1	50	dXSTARG;
190			IV iv;
191
192			PERL_UNUSED_VAR(cv);
193	1		SP -= items;
194	1	50	iv = SvIV(ST(0)) + 1;
195	1	50	PUSHi(iv);
196	1		XSRETURN(1);
197			}
198
199			XS(XS_Devel__PPPort_dAXMARK); /* prototype */
200	1		XS(XS_Devel__PPPort_dAXMARK)
201			{
202	1		dSP;
203	1		dAXMARK;
204	1		dITEMS;
205			IV iv;
206
207			PERL_UNUSED_VAR(cv);
208	1		SP -= items;
209	1	50	iv = SvIV(ST(0)) - 1;
210	1		mPUSHi(iv);
211	1		XSRETURN(1);
212			}
213
214			/* ---- code from parts/inc/newCONSTSUB ---- */
215	1		void call_newCONSTSUB_1(void)
216			{
217			#ifdef PERL_NO_GET_CONTEXT
218			dTHX;
219			#endif
220	1		newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
221	1		}
222
223			extern void call_newCONSTSUB_2(void);
224			extern void call_newCONSTSUB_3(void);
225
226			/* ---- code from parts/inc/sv_xpvf ---- */
227	1		static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
228			{
229			SV *sv;
230			va_list args;
231	1		va_start(args, pat);
232			#if (PERL_BCDVERSION >= 0x5004000)
233	1		sv = vnewSVpvf(pat, &args);
234			#else
235			sv = newSVpv((char *) pat, 0);
236			#endif
237	1		va_end(args);
238	1		return sv;
239			}
240
241	1		static void test_sv_vcatpvf(pTHX_ SV sv, const char pat, ...)
242			{
243			va_list args;
244	1		va_start(args, pat);
245			#if (PERL_BCDVERSION >= 0x5004000)
246	1		sv_vcatpvf(sv, pat, &args);
247			#else
248			sv_catpv(sv, (char *) pat);
249			#endif
250	1		va_end(args);
251	1		}
252
253	1		static void test_sv_vsetpvf(pTHX_ SV sv, const char pat, ...)
254			{
255			va_list args;
256	1		va_start(args, pat);
257			#if (PERL_BCDVERSION >= 0x5004000)
258	1		sv_vsetpvf(sv, pat, &args);
259			#else
260			sv_setpv(sv, (char *) pat);
261			#endif
262	1		va_end(args);
263	1		}
264
265			/* ---- code from parts/inc/variables ---- */
266	1		U32 get_PL_signals_1(void)
267			{
268			#ifdef PERL_NO_GET_CONTEXT
269			dTHX;
270			#endif
271	1		return PL_signals;
272			}
273
274			extern U32 get_PL_signals_2(void);
275			extern U32 get_PL_signals_3(void);
276			int no_dummy_parser_vars(int);
277			int dummy_parser_warning(void);
278
279			/* No PTRSIZE IN 5.004 and below, so PTR2IV would warn and possibly misbehave */
280			#if (PERL_BCDVERSION > 0x5004000)
281			#define ppp_TESTVAR(var) STMT_START { mXPUSHi(PTR2IV(&var)); count++; } STMT_END
282			#else
283			#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var); count++; } STMT_END
284			#endif
285
286			#define ppp_PARSERVAR(type, var) STMT_START { \
287			type volatile my_ ## var; \
288			type volatile *my_p_ ## var; \
289			my_ ## var = var; \
290			my_p_ ## var = &var; \
291			var = my_ ## var; \
292			var = *my_p_ ## var; \
293			mXPUSHi(&var != NULL); \
294			count++; \
295			} STMT_END
296
297			#define ppp_PARSERVAR_dummy STMT_START { \
298			mXPUSHi(1); \
299			count++; \
300			} STMT_END
301
302			#if (PERL_BCDVERSION < 0x5004000)
303			# define ppp_rsfp_t FILE *
304			#else
305			# define ppp_rsfp_t PerlIO *
306			#endif
307
308			#if (PERL_BCDVERSION < 0x5006000)
309			# define ppp_expect_t expectation
310			#elif (PERL_BCDVERSION < 0x5009005)
311			# define ppp_expect_t int
312			#else
313			# define ppp_expect_t U8
314			#endif
315
316			#if (PERL_BCDVERSION < 0x5009005)
317			# define ppp_lex_state_t U32
318			#else
319			# define ppp_lex_state_t U8
320			#endif
321
322			#if (PERL_BCDVERSION < 0x5006000)
323			# define ppp_in_my_t bool
324			#elif (PERL_BCDVERSION < 0x5009005)
325			# define ppp_in_my_t I32
326			#else
327			# define ppp_in_my_t U16
328			#endif
329
330			#if (PERL_BCDVERSION < 0x5009005)
331			# define ppp_error_count_t I32
332			#else
333			# define ppp_error_count_t U8
334			#endif
335
336			/* =========== END XSMISC =================================================== */
337
338			MODULE = Devel::PPPort PACKAGE = Devel::PPPort
339
340			BOOT:
341			/* ---- code from parts/inc/MY_CXT ---- */
342			{
343			MY_CXT_INIT;
344			/* If any of the fields in the my_cxt_t struct need
345			* to be initialised, do it here.
346			*/
347	34		MY_CXT.dummy = 42;
348			}
349
350			/* ---- code from parts/inc/misc ---- */
351			{
352	34		XSPROTO_test_t_ptr p = &XS_Devel__PPPort_dXSTARG;
353	34		newXS("Devel::PPPort::dXSTARG", *p, file);
354			}
355	34		newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
356
357
358			##----------------------------------------------------------------------
359			## XSUBs for testing the implementation in parts/inc/HvNAME
360			##----------------------------------------------------------------------
361
362			char*
363			HvNAME_get(hv)
364			HV *hv
365
366			int
367			HvNAMELEN_get(hv)
368			HV *hv
369
370			##----------------------------------------------------------------------
371			## XSUBs for testing the implementation in parts/inc/MY_CXT
372			##----------------------------------------------------------------------
373
374			int
375			MY_CXT_1()
376			CODE:
377			dMY_CXT;
378	1		RETVAL = MY_CXT.dummy == 42;
379	1		++MY_CXT.dummy;
380			OUTPUT:
381			RETVAL
382
383			int
384			MY_CXT_2()
385			CODE:
386			dMY_CXT;
387	1		RETVAL = MY_CXT.dummy == 43;
388			OUTPUT:
389			RETVAL
390
391			int
392			MY_CXT_CLONE()
393			CODE:
394			MY_CXT_CLONE;
395	1		RETVAL = 42;
396			OUTPUT:
397			RETVAL
398
399			##----------------------------------------------------------------------
400			## XSUBs for testing the implementation in parts/inc/SvPV
401			##----------------------------------------------------------------------
402
403			IV
404			SvPVbyte(sv)
405			SV *sv
406			PREINIT:
407			char *str;
408			STRLEN len;
409			CODE:
410	1	50	str = SvPVbyte(sv, len);
411	1	50	RETVAL = strEQ(str, "mhx") ? (IV) len : (IV) -1;
412			OUTPUT:
413			RETVAL
414
415			IV
416			SvPV_nolen(sv)
417			SV *sv
418			PREINIT:
419			char *str;
420			CODE:
421	2	100	str = SvPV_nolen(sv);
422	2	100	RETVAL = strEQ(str, "mhx") ? 42 : 0;
423			OUTPUT:
424			RETVAL
425
426			IV
427			SvPV_const(sv)
428			SV *sv
429			PREINIT:
430			const char *str;
431			STRLEN len;
432			CODE:
433	2	100	str = SvPV_const(sv, len);
434	2	100	RETVAL = len + (strEQ(str, "mhx") ? 40 : 0);
435			OUTPUT:
436			RETVAL
437
438			IV
439			SvPV_mutable(sv)
440			SV *sv
441			PREINIT:
442			char *str;
443			STRLEN len;
444			CODE:
445	2	100	str = SvPV_mutable(sv, len);
446	2	100	RETVAL = len + (strEQ(str, "mhx") ? 41 : 0);
447			OUTPUT:
448			RETVAL
449
450			IV
451			SvPV_flags(sv)
452			SV *sv
453			PREINIT:
454			char *str;
455			STRLEN len;
456			CODE:
457	2	100	str = SvPV_flags(sv, len, SV_GMAGIC);
458	2	100	RETVAL = len + (strEQ(str, "mhx") ? 42 : 0);
459			OUTPUT:
460			RETVAL
461
462			IV
463			SvPV_flags_const(sv)
464			SV *sv
465			PREINIT:
466			const char *str;
467			STRLEN len;
468			CODE:
469	2	100	str = SvPV_flags_const(sv, len, SV_GMAGIC);
470	2	100	RETVAL = len + (strEQ(str, "mhx") ? 43 : 0);
471			OUTPUT:
472			RETVAL
473
474			IV
475			SvPV_flags_const_nolen(sv)
476			SV *sv
477			PREINIT:
478			const char *str;
479			CODE:
480	2	100	str = SvPV_flags_const_nolen(sv, SV_GMAGIC);
481	2	100	RETVAL = strEQ(str, "mhx") ? 47 : 0;
482			OUTPUT:
483			RETVAL
484
485			IV
486			SvPV_flags_mutable(sv)
487			SV *sv
488			PREINIT:
489			char *str;
490			STRLEN len;
491			CODE:
492	2	100	str = SvPV_flags_mutable(sv, len, SV_GMAGIC);
493	2	100	RETVAL = len + (strEQ(str, "mhx") ? 45 : 0);
494			OUTPUT:
495			RETVAL
496
497			IV
498			SvPV_force(sv)
499			SV *sv
500			PREINIT:
501			char *str;
502			STRLEN len;
503			CODE:
504	4	100	str = SvPV_force(sv, len);
505	4	100	RETVAL = len + (strEQ(str, "mhx") ? 46 : 0);
506			OUTPUT:
507			RETVAL
508
509			IV
510			SvPV_force_nolen(sv)
511			SV *sv
512			PREINIT:
513			char *str;
514			CODE:
515	2	100	str = SvPV_force_nolen(sv);
516	2	100	RETVAL = strEQ(str, "mhx") ? 50 : 0;
517			OUTPUT:
518			RETVAL
519
520			IV
521			SvPV_force_mutable(sv)
522			SV *sv
523			PREINIT:
524			char *str;
525			STRLEN len;
526			CODE:
527	2	100	str = SvPV_force_mutable(sv, len);
528	2	100	RETVAL = len + (strEQ(str, "mhx") ? 48 : 0);
529			OUTPUT:
530			RETVAL
531
532			IV
533			SvPV_force_nomg(sv)
534			SV *sv
535			PREINIT:
536			char *str;
537			STRLEN len;
538			CODE:
539	2	100	str = SvPV_force_nomg(sv, len);
540	2	100	RETVAL = len + (strEQ(str, "mhx") ? 49 : 0);
541			OUTPUT:
542			RETVAL
543
544			IV
545			SvPV_force_nomg_nolen(sv)
546			SV *sv
547			PREINIT:
548			char *str;
549			CODE:
550	2	100	str = SvPV_force_nomg_nolen(sv);
551	2	100	RETVAL = strEQ(str, "mhx") ? 53 : 0;
552			OUTPUT:
553			RETVAL
554
555			IV
556			SvPV_force_flags(sv)
557			SV *sv
558			PREINIT:
559			char *str;
560			STRLEN len;
561			CODE:
562	2	100	str = SvPV_force_flags(sv, len, SV_GMAGIC);
563	2	100	RETVAL = len + (strEQ(str, "mhx") ? 51 : 0);
564			OUTPUT:
565			RETVAL
566
567			IV
568			SvPV_force_flags_nolen(sv)
569			SV *sv
570			PREINIT:
571			char *str;
572			CODE:
573	2	100	str = SvPV_force_flags_nolen(sv, SV_GMAGIC);
574	2	100	RETVAL = strEQ(str, "mhx") ? 55 : 0;
575			OUTPUT:
576			RETVAL
577
578			IV
579			SvPV_force_flags_mutable(sv)
580			SV *sv
581			PREINIT:
582			char *str;
583			STRLEN len;
584			CODE:
585	2	100	str = SvPV_force_flags_mutable(sv, len, SV_GMAGIC);
586	2	100	RETVAL = len + (strEQ(str, "mhx") ? 53 : 0);
587			OUTPUT:
588			RETVAL
589
590			IV
591			SvPV_nolen_const(sv)
592			SV *sv
593			PREINIT:
594			const char *str;
595			CODE:
596	2	100	str = SvPV_nolen_const(sv);
597	2	100	RETVAL = strEQ(str, "mhx") ? 57 : 0;
598			OUTPUT:
599			RETVAL
600
601			IV
602			SvPV_nomg(sv)
603			SV *sv
604			PREINIT:
605			char *str;
606			STRLEN len;
607			CODE:
608	2	100	str = SvPV_nomg(sv, len);
609	2	100	RETVAL = len + (strEQ(str, "mhx") ? 55 : 0);
610			OUTPUT:
611			RETVAL
612
613			IV
614			SvPV_nomg_const(sv)
615			SV *sv
616			PREINIT:
617			const char *str;
618			STRLEN len;
619			CODE:
620	2	100	str = SvPV_nomg_const(sv, len);
621	2	100	RETVAL = len + (strEQ(str, "mhx") ? 56 : 0);
622			OUTPUT:
623			RETVAL
624
625			IV
626			SvPV_nomg_const_nolen(sv)
627			SV *sv
628			PREINIT:
629			const char *str;
630			CODE:
631	2	100	str = SvPV_nomg_const_nolen(sv);
632	2	100	RETVAL = strEQ(str, "mhx") ? 60 : 0;
633			OUTPUT:
634			RETVAL
635
636			IV
637			SvPV_nomg_nolen(sv)
638			SV *sv
639			PREINIT:
640			char *str;
641			CODE:
642	2	100	str = SvPV_nomg_nolen(sv);
643	2	100	RETVAL = strEQ(str, "mhx") ? 61 : 0;
644			OUTPUT:
645			RETVAL
646
647			void
648			SvPV_renew(sv, nlen, insv)
649			SV *sv
650			STRLEN nlen
651			SV *insv
652			PREINIT:
653			STRLEN slen;
654			const char *str;
655			PPCODE:
656	2	50	str = SvPV_const(insv, slen);
657	2	50	XPUSHs(sv);
658	2	50	mXPUSHi(SvLEN(sv));
659	2		SvPV_renew(sv, nlen);
660	2		Copy(str, SvPVX(sv), slen + 1, char);
661	2		SvCUR_set(sv, slen);
662	2	50	mXPUSHi(SvLEN(sv));
663
664			##----------------------------------------------------------------------
665			## XSUBs for testing the implementation in parts/inc/SvREFCNT
666			##----------------------------------------------------------------------
667
668			void
669			SvREFCNT()
670			PREINIT:
671			SV sv, svr;
672			PPCODE:
673	1		sv = newSV(0);
674	1	50	mXPUSHi(SvREFCNT(sv) == 1);
675	1		svr = SvREFCNT_inc(sv);
676	1	50	mXPUSHi(sv == svr);
677	1	50	mXPUSHi(SvREFCNT(sv) == 2);
678	1		svr = SvREFCNT_inc_simple(sv);
679	1	50	mXPUSHi(sv == svr);
680	1	50	mXPUSHi(SvREFCNT(sv) == 3);
681	1		svr = SvREFCNT_inc_NN(sv);
682	1	50	mXPUSHi(sv == svr);
683	1	50	mXPUSHi(SvREFCNT(sv) == 4);
684	1		svr = SvREFCNT_inc_simple_NN(sv);
685	1	50	mXPUSHi(sv == svr);
686	1	50	mXPUSHi(SvREFCNT(sv) == 5);
687	1		SvREFCNT_inc_void(sv);
688	1	50	mXPUSHi(SvREFCNT(sv) == 6);
689	1	50	SvREFCNT_inc_simple_void(sv);
690	1	50	mXPUSHi(SvREFCNT(sv) == 7);
691	1		SvREFCNT_inc_void_NN(sv);
692	1	50	mXPUSHi(SvREFCNT(sv) == 8);
693	1		SvREFCNT_inc_simple_void_NN(sv);
694	1	50	mXPUSHi(SvREFCNT(sv) == 9);
695	9	100	while (SvREFCNT(sv) > 1)
696	8		SvREFCNT_dec(sv);
697	1	50	mXPUSHi(SvREFCNT(sv) == 1);
698	1		SvREFCNT_dec(sv);
699	1		XSRETURN(14);
700
701			##----------------------------------------------------------------------
702			## XSUBs for testing the implementation in parts/inc/Sv_set
703			##----------------------------------------------------------------------
704
705			IV
706			TestSvUV_set(sv, val)
707			SV *sv
708			UV val
709			CODE:
710	1		SvUV_set(sv, val);
711	1	50	RETVAL = SvUVX(sv) == val ? 42 : -1;
712			OUTPUT:
713			RETVAL
714
715			IV
716			TestSvPVX_const(sv)
717			SV *sv
718			CODE:
719	1	50	RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1;
720			OUTPUT:
721			RETVAL
722
723			IV
724			TestSvPVX_mutable(sv)
725			SV *sv
726			CODE:
727	1	50	RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1;
728			OUTPUT:
729			RETVAL
730
731			void
732			TestSvSTASH_set(sv, name)
733			SV *sv
734			char *name
735			CODE:
736	1		sv = SvRV(sv);
737	1		SvREFCNT_dec(SvSTASH(sv));
738	1		SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0)));
739
740			##----------------------------------------------------------------------
741			## XSUBs for testing the implementation in parts/inc/call
742			##----------------------------------------------------------------------
743
744			I32
745			G_SCALAR()
746			CODE:
747	2		RETVAL = G_SCALAR;
748			OUTPUT:
749			RETVAL
750
751			I32
752			G_ARRAY()
753			CODE:
754	2		RETVAL = G_ARRAY;
755			OUTPUT:
756			RETVAL
757
758			I32
759			G_DISCARD()
760			CODE:
761	2		RETVAL = G_DISCARD;
762			OUTPUT:
763			RETVAL
764
765			void
766			eval_sv(sv, flags)
767			SV* sv
768			I32 flags
769			PREINIT:
770			I32 i;
771			PPCODE:
772	6		PUTBACK;
773	6		i = eval_sv(sv, flags);
774	6		SPAGAIN;
775	6	50	EXTEND(SP, 1);
776	6		mPUSHi(i);
777
778			void
779			eval_pv(p, croak_on_error)
780			char* p
781			I32 croak_on_error
782			PPCODE:
783	2		PUTBACK;
784	2	50	EXTEND(SP, 1);
785	2		PUSHs(eval_pv(p, croak_on_error));
786
787			void
788			call_sv(sv, flags, ...)
789			SV* sv
790			I32 flags
791			PREINIT:
792			I32 i;
793			PPCODE:
794	45	100	for (i=0; i
795	27		ST(i) = ST(i+2); /* pop first two args */
796	18	50	PUSHMARK(SP);
797	18		SP += items - 2;
798	18		PUTBACK;
799	18		i = call_sv(sv, flags);
800	18		SPAGAIN;
801	18	50	EXTEND(SP, 1);
802	18		mPUSHi(i);
803
804			void
805			call_pv(subname, flags, ...)
806			char* subname
807			I32 flags
808			PREINIT:
809			I32 i;
810			PPCODE:
811	15	100	for (i=0; i
812	9		ST(i) = ST(i+2); /* pop first two args */
813	6	50	PUSHMARK(SP);
814	6		SP += items - 2;
815	6		PUTBACK;
816	6		i = call_pv(subname, flags);
817	6		SPAGAIN;
818	6	50	EXTEND(SP, 1);
819	6		mPUSHi(i);
820
821			void
822			call_argv(subname, flags, ...)
823			char* subname
824			I32 flags
825			PREINIT:
826			I32 i;
827			char *args[8];
828			PPCODE:
829	6	50	if (items > 8) /* play safe */
830	0		XSRETURN_UNDEF;
831	15	100	for (i=2; i
832	9	50	args[i-2] = SvPV_nolen(ST(i));
833	6		args[items-2] = NULL;
834	6		PUTBACK;
835	6		i = call_argv(subname, flags, args);
836	6		SPAGAIN;
837	6	50	EXTEND(SP, 1);
838	6		mPUSHi(i);
839
840			void
841			call_method(methname, flags, ...)
842			char* methname
843			I32 flags
844			PREINIT:
845			I32 i;
846			PPCODE:
847	21	100	for (i=0; i
848	15		ST(i) = ST(i+2); /* pop first two args */
849	6	50	PUSHMARK(SP);
850	6		SP += items - 2;
851	6		PUTBACK;
852	6		i = call_method(methname, flags);
853	6		SPAGAIN;
854	6	50	EXTEND(SP, 1);
855	6		mPUSHi(i);
856
857			void
858			call_sv_G_METHOD(sv, flags, ...)
859			SV* sv
860			I32 flags
861			PREINIT:
862			I32 i;
863			PPCODE:
864	21	100	for (i=0; i
865	15		ST(i) = ST(i+2); /* pop first two args */
866	6	50	PUSHMARK(SP);
867	6		SP += items - 2;
868	6		PUTBACK;
869	6		i = call_sv(sv, flags \| G_METHOD);
870	6		SPAGAIN;
871	6	50	EXTEND(SP, 1);
872	6		mPUSHi(i);
873
874			void
875			load_module(flags, name, version, ...)
876			U32 flags
877			SV *name
878			SV *version
879			CODE:
880			/* Both SV parameters are donated to the ops built inside
881			load_module, so we need to bump the refcounts. */
882	1		Perl_load_module(aTHX_ flags, SvREFCNT_inc_simple(name),
883	1		SvREFCNT_inc_simple(version), NULL);
884
885			##----------------------------------------------------------------------
886			## XSUBs for testing the implementation in parts/inc/cop
887			##----------------------------------------------------------------------
888
889			char *
890			CopSTASHPV()
891			CODE:
892	1	50	RETVAL = CopSTASHPV(PL_curcop);
		50
		50
		50
		0
		50
		50
893			OUTPUT:
894			RETVAL
895
896			char *
897			CopFILE()
898			CODE:
899	1	50	RETVAL = CopFILE(PL_curcop);
900			OUTPUT:
901			RETVAL
902
903			#if (PERL_BCDVERSION >= 0x5006000)
904
905			void
906			caller_cx(level)
907			I32 level
908			PREINIT:
909			const PERL_CONTEXT cx, dbcx;
910			const char *pv;
911			const GV *gv;
912			PPCODE:
913	6		cx = caller_cx(level, &dbcx);
914	6	100	if (!cx) XSRETURN_EMPTY;
915
916	5	50	EXTEND(SP, 4);
917
918	5	50	pv = CopSTASHPV(cx->blk_oldcop);
		50
		50
		50
		0
		50
		50
919	5	50	ST(0) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
920	5		gv = CvGV(cx->blk_sub.cv);
921	5	50	ST(1) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;
922
923	5	50	pv = CopSTASHPV(dbcx->blk_oldcop);
		50
		50
		50
		0
		50
		50
924	5	50	ST(2) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
925	5		gv = CvGV(dbcx->blk_sub.cv);
926	5	50	ST(3) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;
927
928	6		XSRETURN(4);
929
930			#endif /* 5.6.0 */
931
932			##----------------------------------------------------------------------
933			## XSUBs for testing the implementation in parts/inc/exception
934			##----------------------------------------------------------------------
935
936			int
937			exception(throw_e)
938			int throw_e
939			OUTPUT:
940			RETVAL
941
942			##----------------------------------------------------------------------
943			## XSUBs for testing the implementation in parts/inc/format
944			##----------------------------------------------------------------------
945
946			void
947			croak_NVgf(num)
948			NV num
949			PPCODE:
950	1		Perl_croak(aTHX_ "%.20" NVgf "\n", num);
951
952			##----------------------------------------------------------------------
953			## XSUBs for testing the implementation in parts/inc/grok
954			##----------------------------------------------------------------------
955
956			UV
957			grok_number(string)
958			SV *string
959			PREINIT:
960			const char *pv;
961			STRLEN len;
962			CODE:
963	2	50	pv = SvPV(string, len);
964	2	100	if (!grok_number(pv, len, &RETVAL))
965	1		XSRETURN_UNDEF;
966			OUTPUT:
967			RETVAL
968
969			UV
970			grok_bin(string)
971			SV *string
972			PREINIT:
973			char *pv;
974	1		I32 flags = 0;
975			STRLEN len;
976			CODE:
977	1	50	pv = SvPV(string, len);
978	1		RETVAL = grok_bin(pv, &len, &flags, NULL);
979			OUTPUT:
980			RETVAL
981
982			UV
983			grok_hex(string)
984			SV *string
985			PREINIT:
986			char *pv;
987	1		I32 flags = 0;
988			STRLEN len;
989			CODE:
990	1	50	pv = SvPV(string, len);
991	1		RETVAL = grok_hex(pv, &len, &flags, NULL);
992			OUTPUT:
993			RETVAL
994
995			UV
996			grok_oct(string)
997			SV *string
998			PREINIT:
999			char *pv;
1000	1		I32 flags = 0;
1001			STRLEN len;
1002			CODE:
1003	1	50	pv = SvPV(string, len);
1004	1		RETVAL = grok_oct(pv, &len, &flags, NULL);
1005			OUTPUT:
1006			RETVAL
1007
1008			UV
1009			Perl_grok_number(string)
1010			SV *string
1011			PREINIT:
1012			const char *pv;
1013			STRLEN len;
1014			CODE:
1015	2	50	pv = SvPV(string, len);
1016	2	100	if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
1017	1		XSRETURN_UNDEF;
1018			OUTPUT:
1019			RETVAL
1020
1021			UV
1022			Perl_grok_bin(string)
1023			SV *string
1024			PREINIT:
1025			char *pv;
1026	1		I32 flags = 0;
1027			STRLEN len;
1028			CODE:
1029	1	50	pv = SvPV(string, len);
1030	1		RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
1031			OUTPUT:
1032			RETVAL
1033
1034			UV
1035			Perl_grok_hex(string)
1036			SV *string
1037			PREINIT:
1038			char *pv;
1039	1		I32 flags = 0;
1040			STRLEN len;
1041			CODE:
1042	1	50	pv = SvPV(string, len);
1043	1		RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
1044			OUTPUT:
1045			RETVAL
1046
1047			UV
1048			Perl_grok_oct(string)
1049			SV *string
1050			PREINIT:
1051			char *pv;
1052	1		I32 flags = 0;
1053			STRLEN len;
1054			CODE:
1055	1	50	pv = SvPV(string, len);
1056	1		RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
1057			OUTPUT:
1058			RETVAL
1059
1060			##----------------------------------------------------------------------
1061			## XSUBs for testing the implementation in parts/inc/gv
1062			##----------------------------------------------------------------------
1063
1064			int
1065			GvSVn()
1066			PREINIT:
1067			GV* gv;
1068			CODE:
1069	1		RETVAL = 0;
1070	1		gv = gv_fetchpvs("Devel::PPPort::GvTest", GV_ADDMULTI, SVt_PVGV);
1071	1	50	if (GvSVn(gv) != NULL)
		50
1072			{
1073	1		RETVAL++;
1074			}
1075			OUTPUT:
1076			RETVAL
1077
1078			int
1079			isGV_with_GP()
1080			PREINIT:
1081			GV* gv;
1082			CODE:
1083	1		RETVAL = 0;
1084	1		gv = gv_fetchpvs("Devel::PPPort::GvTest", GV_ADDMULTI, SVt_PVGV);
1085	1	50	if (isGV_with_GP(gv))
		50
		0
1086			{
1087	1		RETVAL++;
1088			}
1089	1	50	if (!isGV(&PL_sv_undef))
1090			{
1091	1		RETVAL++;
1092			}
1093			OUTPUT:
1094			RETVAL
1095
1096			int
1097			get_cvn_flags()
1098			PREINIT:
1099			CV* xv;
1100			CODE:
1101	1		RETVAL = 0;
1102	1		xv = get_cvn_flags("Devel::PPPort::foobar", sizeof("Devel::PPPort::foobar")-1, 0);
1103	1	50	if(xv == NULL) RETVAL++;
1104	1		xv = get_cvn_flags("Devel::PPPort::foobar", sizeof("Devel::PPPort::foobar")-1, GV_ADDMULTI);
1105	1	50	if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
		50
1106	1		xv = get_cvn_flags("Devel::PPPort::get_cvn_flags", sizeof("Devel::PPPort::get_cvn_flags")-1, 0);
1107	1	50	if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
		50
1108			OUTPUT:
1109			RETVAL
1110
1111			SV*
1112			gv_fetchpvn_flags()
1113			CODE:
1114			#if (PERL_BCDVERSION < 0x5009002) \|\| (PERL_BCDVERSION > 0x5009003) /* 5.9.2 and 5.9.3 ignore the length param */
1115	1		RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSIONFAKE", sizeof("Devel::PPPort::VERSIONFAKE")-5, 0, SVt_PV));
1116			#else
1117			RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSION", 0, 0, SVt_PV));
1118			#endif
1119			OUTPUT:
1120			RETVAL
1121
1122			SV*
1123			gv_fetchsv(name)
1124			SV *name
1125			CODE:
1126	1		RETVAL = newRV_inc((SV*)gv_fetchsv(name, 0, SVt_PV));
1127			OUTPUT:
1128			RETVAL
1129
1130			void
1131			gv_init_type(namesv, multi, flags)
1132			SV* namesv
1133			int multi
1134			I32 flags
1135			PREINIT:
1136	1		HV *defstash = gv_stashpv("main", 0);
1137			STRLEN len;
1138	1	50	const char * const name = SvPV_const(namesv, len);
1139	1		GV gv = (GV**)hv_fetch(defstash, name, len, TRUE);
1140			PPCODE:
1141	1	50	if (SvTYPE(gv) == SVt_PVGV)
1142	0		Perl_croak(aTHX_ "GV is already a PVGV");
1143	1	50	if (multi) flags \|= GV_ADDMULTI;
1144	1		gv_init_pvn(gv, defstash, name, len, flags);
1145	1	50	XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
		50
1146
1147			##----------------------------------------------------------------------
1148			## XSUBs for testing the implementation in parts/inc/limits
1149			##----------------------------------------------------------------------
1150
1151			IV
1152			iv_size()
1153			CODE:
1154	1		RETVAL = IVSIZE == sizeof(IV);
1155			OUTPUT:
1156			RETVAL
1157
1158			IV
1159			uv_size()
1160			CODE:
1161	1		RETVAL = UVSIZE == sizeof(UV);
1162			OUTPUT:
1163			RETVAL
1164
1165			IV
1166			iv_type()
1167			CODE:
1168	1		RETVAL = sizeof(IVTYPE) == sizeof(IV);
1169			OUTPUT:
1170			RETVAL
1171
1172			IV
1173			uv_type()
1174			CODE:
1175	1		RETVAL = sizeof(UVTYPE) == sizeof(UV);
1176			OUTPUT:
1177			RETVAL
1178
1179			##----------------------------------------------------------------------
1180			## XSUBs for testing the implementation in parts/inc/mPUSH
1181			##----------------------------------------------------------------------
1182
1183			void
1184			mPUSHs()
1185			PPCODE:
1186	1	50	EXTEND(SP, 3);
1187	1		mPUSHs(newSVpv("foo", 0));
1188	1		mPUSHs(newSVpv("bar13", 3));
1189	1		mPUSHs(newSViv(42));
1190	1		XSRETURN(3);
1191
1192			void
1193			mPUSHp()
1194			PPCODE:
1195	1	50	EXTEND(SP, 3);
1196	1		mPUSHp("one", 3);
1197	1		mPUSHp("two", 3);
1198	1		mPUSHp("three", 5);
1199	1		XSRETURN(3);
1200
1201			void
1202			mPUSHn()
1203			PPCODE:
1204	1	50	EXTEND(SP, 3);
1205	1		mPUSHn(0.5);
1206	1		mPUSHn(-0.25);
1207	1		mPUSHn(0.125);
1208	1		XSRETURN(3);
1209
1210			void
1211			mPUSHi()
1212			PPCODE:
1213	1	50	EXTEND(SP, 3);
1214	1		mPUSHi(-1);
1215	1		mPUSHi(2);
1216	1		mPUSHi(-3);
1217	1		XSRETURN(3);
1218
1219			void
1220			mPUSHu()
1221			PPCODE:
1222	1	50	EXTEND(SP, 3);
1223	1		mPUSHu(1);
1224	1		mPUSHu(2);
1225	1		mPUSHu(3);
1226	1		XSRETURN(3);
1227
1228			void
1229			mXPUSHs()
1230			PPCODE:
1231	1	50	mXPUSHs(newSVpv("foo", 0));
1232	1	50	mXPUSHs(newSVpv("bar13", 3));
1233	1	50	mXPUSHs(newSViv(42));
1234	1		XSRETURN(3);
1235
1236			void
1237			mXPUSHp()
1238			PPCODE:
1239	1	50	mXPUSHp("one", 3);
1240	1	50	mXPUSHp("two", 3);
1241	1	50	mXPUSHp("three", 5);
1242	1		XSRETURN(3);
1243
1244			void
1245			mXPUSHn()
1246			PPCODE:
1247	1	50	mXPUSHn(0.5);
1248	1	50	mXPUSHn(-0.25);
1249	1	50	mXPUSHn(0.125);
1250	1		XSRETURN(3);
1251
1252			void
1253			mXPUSHi()
1254			PPCODE:
1255	1	50	mXPUSHi(-1);
1256	1	50	mXPUSHi(2);
1257	1	50	mXPUSHi(-3);
1258	1		XSRETURN(3);
1259
1260			void
1261			mXPUSHu()
1262			PPCODE:
1263	1	50	mXPUSHu(1);
1264	1	50	mXPUSHu(2);
1265	1	50	mXPUSHu(3);
1266	1		XSRETURN(3);
1267
1268			##----------------------------------------------------------------------
1269			## XSUBs for testing the implementation in parts/inc/magic
1270			##----------------------------------------------------------------------
1271
1272			SV *
1273			new_with_other_mg(package, ...)
1274			SV *package
1275			PREINIT:
1276			HV *self;
1277			HV *stash;
1278			SV *self_ref;
1279	1		const char *data = "hello\0";
1280			MAGIC *mg;
1281			CODE:
1282	1		self = newHV();
1283	1	50	stash = gv_stashpv(SvPV_nolen(package), 0);
1284
1285	1		self_ref = newRV_noinc((SV*)self);
1286
1287	1		sv_magic((SV*)self, NULL, PERL_MAGIC_ext, data, strlen(data));
1288	1		mg = mg_find((SV*)self, PERL_MAGIC_ext);
1289	1	50	if (mg)
1290	1		mg->mg_virtual = &other_mg_vtbl;
1291			else
1292	0		croak("No mg!");
1293
1294	1		RETVAL = sv_bless(self_ref, stash);
1295			OUTPUT:
1296			RETVAL
1297
1298			SV *
1299			new_with_mg(package, ...)
1300			SV *package
1301			PREINIT:
1302			HV *self;
1303			HV *stash;
1304			SV *self_ref;
1305	1		const char *data = "hello\0";
1306			MAGIC *mg;
1307			CODE:
1308	1		self = newHV();
1309	1	50	stash = gv_stashpv(SvPV_nolen(package), 0);
1310
1311	1		self_ref = newRV_noinc((SV*)self);
1312
1313	1		sv_magic((SV*)self, NULL, PERL_MAGIC_ext, data, strlen(data));
1314	1		mg = mg_find((SV*)self, PERL_MAGIC_ext);
1315	1	50	if (mg)
1316	1		mg->mg_virtual = &null_mg_vtbl;
1317			else
1318	0		croak("No mg!");
1319
1320	1		RETVAL = sv_bless(self_ref, stash);
1321			OUTPUT:
1322			RETVAL
1323
1324			void
1325			remove_null_magic(self)
1326			SV *self
1327			PREINIT:
1328			HV *obj;
1329			PPCODE:
1330	2		obj = (HV*) SvRV(self);
1331
1332	2		sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl);
1333
1334			void
1335			remove_other_magic(self)
1336			SV *self
1337			PREINIT:
1338			HV *obj;
1339			PPCODE:
1340	1		obj = (HV*) SvRV(self);
1341
1342	1		sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &other_mg_vtbl);
1343
1344			void
1345			as_string(self)
1346			SV *self
1347			PREINIT:
1348			HV *obj;
1349			MAGIC *mg;
1350			PPCODE:
1351	6		obj = (HV*) SvRV(self);
1352
1353	6	100	if ((mg = mg_findext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl))) {
1354	2	50	XPUSHs(sv_2mortal(newSVpv(mg->mg_ptr, strlen(mg->mg_ptr))));
1355			} else {
1356	4	50	XPUSHs(sv_2mortal(newSVpvs("Sorry, your princess is in another castle.")));
1357			}
1358
1359			void
1360			sv_catpv_mg(sv, string)
1361			SV *sv;
1362			char *string;
1363			CODE:
1364	1		sv_catpv_mg(sv, string);
1365
1366			void
1367			sv_catpvn_mg(sv, sv2)
1368			SV *sv;
1369			SV *sv2;
1370			PREINIT:
1371			char *str;
1372			STRLEN len;
1373			CODE:
1374	1	50	str = SvPV(sv2, len);
1375	1		sv_catpvn_mg(sv, str, len);
1376
1377			void
1378			sv_catsv_mg(sv, sv2)
1379			SV *sv;
1380			SV *sv2;
1381			CODE:
1382	1		sv_catsv_mg(sv, sv2);
1383
1384			void
1385			sv_setiv_mg(sv, iv)
1386			SV *sv;
1387			IV iv;
1388			CODE:
1389	1		sv_setiv_mg(sv, iv);
1390
1391			void
1392			sv_setnv_mg(sv, nv)
1393			SV *sv;
1394			NV nv;
1395			CODE:
1396	1		sv_setnv_mg(sv, nv);
1397
1398			void
1399			sv_setpv_mg(sv, pv)
1400			SV *sv;
1401			char *pv;
1402			CODE:
1403	1		sv_setpv_mg(sv, pv);
1404
1405			void
1406			sv_setpvn_mg(sv, sv2)
1407			SV *sv;
1408			SV *sv2;
1409			PREINIT:
1410			char *str;
1411			STRLEN len;
1412			CODE:
1413	1	50	str = SvPV(sv2, len);
1414	1		sv_setpvn_mg(sv, str, len);
1415
1416			void
1417			sv_setsv_mg(sv, sv2)
1418			SV *sv;
1419			SV *sv2;
1420			CODE:
1421	1		sv_setsv_mg(sv, sv2);
1422
1423			void
1424			sv_setuv_mg(sv, uv)
1425			SV *sv;
1426			UV uv;
1427			CODE:
1428	1		sv_setuv_mg(sv, uv);
1429
1430			void
1431			sv_usepvn_mg(sv, sv2)
1432			SV *sv;
1433			SV *sv2;
1434			PREINIT:
1435			char str, copy;
1436			STRLEN len;
1437			CODE:
1438	1	50	str = SvPV(sv2, len);
1439	1		New(42, copy, len+1, char);
1440	1		Copy(str, copy, len+1, char);
1441	1		sv_usepvn_mg(sv, copy, len);
1442
1443			int
1444			SvVSTRING_mg(sv)
1445			SV *sv;
1446			CODE:
1447	2	100	RETVAL = SvVSTRING_mg(sv) != NULL;
		50
1448			OUTPUT:
1449			RETVAL
1450
1451			int
1452			sv_magic_portable(sv)
1453			SV *sv
1454			PREINIT:
1455			MAGIC *mg;
1456	1		const char *foo = "foo";
1457			CODE:
1458			#if (PERL_BCDVERSION >= 0x5004000)
1459	1		sv_magic_portable(sv, 0, '~', foo, 0);
1460	1		mg = mg_find(sv, '~');
1461	1	50	if (!mg)
1462	0		croak("No mg!");
1463
1464	1		RETVAL = mg->mg_ptr == foo;
1465			#else
1466			sv_magic(sv, 0, '~', (char *) foo, strlen(foo));
1467			mg = mg_find(sv, '~');
1468			RETVAL = strEQ(mg->mg_ptr, foo);
1469			#endif
1470	1		sv_unmagic(sv, '~');
1471			OUTPUT:
1472			RETVAL
1473
1474			##----------------------------------------------------------------------
1475			## XSUBs for testing the implementation in parts/inc/memory
1476			##----------------------------------------------------------------------
1477
1478			int
1479			checkmem()
1480			PREINIT:
1481			char *p;
1482
1483			CODE:
1484	1		RETVAL = 0;
1485	1		Newx(p, 6, char);
1486	1		CopyD("Hello", p, 6, char);
1487	1	50	if (memEQ(p, "Hello", 6))
1488	1		RETVAL++;
1489	1		ZeroD(p, 6, char);
1490	1	50	if (memEQ(p, "\0\0\0\0\0\0", 6))
1491	1		RETVAL++;
1492	1	50	if (memEQs(p, 6, "\0\0\0\0\0\0"))
1493	1		RETVAL++;
1494	1		Poison(p, 6, char);
1495	1	50	if (memNE(p, "\0\0\0\0\0\0", 6))
1496	1		RETVAL++;
1497	1	50	if (memNEs(p, 6, "\0\0\0\0\0\0"))
1498	1		RETVAL++;
1499	1		Safefree(p);
1500
1501	1		Newxz(p, 6, char);
1502	1	50	if (memEQ(p, "\0\0\0\0\0\0", 6))
1503	1		RETVAL++;
1504	1		Safefree(p);
1505
1506	1		Newxc(p, 3, short, char);
1507	1		Safefree(p);
1508
1509			OUTPUT:
1510			RETVAL
1511
1512			##----------------------------------------------------------------------
1513			## XSUBs for testing the implementation in parts/inc/mess
1514			##----------------------------------------------------------------------
1515
1516			void
1517			croak_sv(sv)
1518			SV *sv
1519			CODE:
1520	18		croak_sv(sv);
1521
1522			void
1523			die_sv(sv)
1524			SV *sv
1525			CODE:
1526	0		(void)die_sv(sv);
1527
1528			void
1529			warn_sv(sv)
1530			SV *sv
1531			CODE:
1532	11		warn_sv(sv);
1533
1534			SV *
1535			mess_sv(sv, consume)
1536			SV *sv
1537			bool consume
1538			CODE:
1539	22		RETVAL = newSVsv(mess_sv(sv, consume));
1540			OUTPUT:
1541			RETVAL
1542
1543			void
1544			croak_no_modify()
1545			CODE:
1546	1		croak_no_modify();
1547
1548			void
1549			croak_memory_wrap()
1550			CODE:
1551	1		croak_memory_wrap();
1552
1553			void
1554			croak_xs_usage(params)
1555			char *params
1556			CODE:
1557	1		croak_xs_usage(cv, params);
1558
1559			##----------------------------------------------------------------------
1560			## XSUBs for testing the implementation in parts/inc/misc
1561			##----------------------------------------------------------------------
1562
1563			int
1564			OpSIBLING_tests()
1565			PREINIT:
1566			OP *x;
1567			OP *kid;
1568			OP *middlekid;
1569			OP *lastkid;
1570	1		int count = 0;
1571	1		int failures = 0;
1572			int i;
1573			CODE:
1574	1		x = newOP(OP_PUSHMARK, 0);
1575
1576			/* No siblings yet! */
1577	1	50	if (OpHAS_SIBLING(x) \|\| OpSIBLING(x)) {
		50
		0
1578	0		failures++; warn("Op should not have had a sib");
1579			}
1580
1581
1582			/* Add 2 siblings */
1583	1		kid = x;
1584
1585	3	100	for (i = 0; i < 2; i++) {
1586	2		OP *newsib = newOP(OP_PUSHMARK, 0);
1587	2		OpMORESIB_set(kid, newsib);
1588
1589	2	50	kid = OpSIBLING(kid);
1590	2		lastkid = kid;
1591			}
1592	1	50	middlekid = OpSIBLING(x);
1593
1594			/* Should now have a sibling */
1595	1	50	if (! OpHAS_SIBLING(x) \|\| ! OpSIBLING(x) ) {
		50
		50
1596	0		failures++; warn("Op should have had a sib after moresib_set");
1597			}
1598
1599			/* Count the siblings */
1600	3	50	for (kid = OpSIBLING(x); kid; kid = OpSIBLING(kid)) {
		100
		100
1601	2		count++;
1602			}
1603
1604	1	50	if (count != 2) {
1605	0		failures++; warn("Kid had %d sibs, expected 2", count);
1606			}
1607
1608	1	50	if (OpHAS_SIBLING(lastkid) \|\| OpSIBLING(lastkid)) {
		50
		0
1609	0		failures++; warn("Last kid should not have a sib");
1610			}
1611
1612			/* Really sets the parent, and says 'no more siblings' */
1613	1		OpLASTSIB_set(x, lastkid);
1614
1615	1	50	if (OpHAS_SIBLING(x) \|\| OpSIBLING(x)) {
		50
		0
1616	0		failures++; warn("OpLASTSIB_set failed?");
1617			}
1618
1619			/* Restore the kid */
1620	1		OpMORESIB_set(x, lastkid);
1621
1622			/* Try to remove it again */
1623	1		OpLASTSIB_set(x, NULL);
1624
1625	1	50	if (OpHAS_SIBLING(x) \|\| OpSIBLING(x)) {
		50
		0
1626	0		failures++; warn("OpLASTSIB_set with NULL failed?");
1627			}
1628
1629			/* Try to restore with maybesib_set */
1630	1	50	OpMAYBESIB_set(x, lastkid, NULL);
1631
1632	1	50	if (! OpHAS_SIBLING(x) \|\| ! OpSIBLING(x) ) {
		50
		50
1633	0		failures++; warn("Op should have had a sib after maybesibset");
1634			}
1635
1636	1		op_free(lastkid);
1637	1		op_free(middlekid);
1638	1		op_free(x);
1639	1		RETVAL = failures;
1640			OUTPUT:
1641			RETVAL
1642
1643			int
1644			SvRXOK(sv)
1645			SV *sv
1646			CODE:
1647	4		RETVAL = SvRXOK(sv);
1648			OUTPUT:
1649			RETVAL
1650
1651			int
1652			ptrtests()
1653			PREINIT:
1654	1		int var, *p = &var;
1655
1656			CODE:
1657	1		RETVAL = 0;
1658	1		RETVAL += PTR2nat(p) != 0 ? 1 : 0;
1659	1	50	RETVAL += PTR2ul(p) != 0UL ? 2 : 0;
1660	1	50	RETVAL += PTR2UV(p) != (UV) 0 ? 4 : 0;
1661	1	50	RETVAL += PTR2IV(p) != (IV) 0 ? 8 : 0;
1662	1	50	RETVAL += PTR2NV(p) != (NV) 0 ? 16 : 0;
1663	1	50	RETVAL += p > NUM2PTR(int *, 0) ? 32 : 0;
1664
1665			OUTPUT:
1666			RETVAL
1667
1668			int
1669			gv_stashpvn(name, create)
1670			char *name
1671			I32 create
1672			CODE:
1673	3		RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
1674			OUTPUT:
1675			RETVAL
1676
1677			int
1678			get_sv(name, create)
1679			char *name
1680			I32 create
1681			CODE:
1682	3		RETVAL = get_sv(name, create) != NULL;
1683			OUTPUT:
1684			RETVAL
1685
1686			int
1687			get_av(name, create)
1688			char *name
1689			I32 create
1690			CODE:
1691	3		RETVAL = get_av(name, create) != NULL;
1692			OUTPUT:
1693			RETVAL
1694
1695			int
1696			get_hv(name, create)
1697			char *name
1698			I32 create
1699			CODE:
1700	3		RETVAL = get_hv(name, create) != NULL;
1701			OUTPUT:
1702			RETVAL
1703
1704			int
1705			get_cv(name, create)
1706			char *name
1707			I32 create
1708			CODE:
1709	3		RETVAL = get_cv(name, create) != NULL;
1710			OUTPUT:
1711			RETVAL
1712
1713			void
1714			xsreturn(two)
1715			int two
1716			PPCODE:
1717	2	50	mXPUSHp("test1", 5);
1718	2	100	if (two)
1719	1	50	mXPUSHp("test2", 5);
1720	2	100	if (two)
1721	1		XSRETURN(2);
1722			else
1723	1		XSRETURN(1);
1724
1725			SV*
1726			boolSV(value)
1727			int value
1728			CODE:
1729	2	100	RETVAL = newSVsv(boolSV(value));
1730			OUTPUT:
1731			RETVAL
1732
1733			SV*
1734			DEFSV()
1735			CODE:
1736	2	50	RETVAL = newSVsv(DEFSV);
1737			OUTPUT:
1738			RETVAL
1739
1740			void
1741			DEFSV_modify()
1742			PPCODE:
1743	1	50	XPUSHs(sv_mortalcopy(DEFSV));
		50
1744	1		ENTER;
1745	1		SAVE_DEFSV;
1746	1		DEFSV_set(newSVpvs("DEFSV"));
1747	1	50	XPUSHs(sv_mortalcopy(DEFSV));
		50
1748			/* Yes, this leaks the above scalar; 5.005 with threads for some reason */
1749			/* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */
1750			/* sv_2mortal(DEFSV); */
1751	1		LEAVE;
1752	1	50	XPUSHs(sv_mortalcopy(DEFSV));
		50
1753	1		XSRETURN(3);
1754
1755			int
1756			ERRSV()
1757			CODE:
1758	2	50	RETVAL = SvTRUE(ERRSV);
		50
		50
		50
		0
		0
		50
		50
		0
		0
		0
		0
		50
		50
		50
		50
		50
		100
		50
		50
		0
		0
		100
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
1759			OUTPUT:
1760			RETVAL
1761
1762			SV*
1763			UNDERBAR()
1764			CODE:
1765			{
1766			dUNDERBAR;
1767	1		RETVAL = newSVsv(UNDERBAR);
1768			}
1769			OUTPUT:
1770			RETVAL
1771
1772			void
1773			prepush()
1774			CODE:
1775			{
1776	1	50	dXSTARG;
1777	1		XSprePUSH;
1778	1	50	PUSHi(42);
1779	1		XSRETURN(1);
1780			}
1781
1782			int
1783			PERL_ABS(a)
1784			int a
1785
1786			void
1787			SVf(x)
1788			SV *x
1789			PPCODE:
1790			#if (PERL_BCDVERSION >= 0x5004000)
1791	2		x = sv_2mortal(newSVpvf("[%" SVf "]", SVfARG(x)));
1792			#endif
1793	2	50	XPUSHs(x);
1794	2		XSRETURN(1);
1795
1796			void
1797			Perl_ppaddr_t(string)
1798			char *string
1799			PREINIT:
1800			Perl_ppaddr_t lower;
1801			PPCODE:
1802	1		lower = PL_ppaddr[OP_LC];
1803	1	50	mXPUSHs(newSVpv(string, 0));
1804	1		PUTBACK;
1805	1		ENTER;
1806	1		(void)*(lower)(aTHXR);
1807	1		SPAGAIN;
1808	1		LEAVE;
1809	1		XSRETURN(1);
1810
1811			#if (PERL_BCDVERSION >= 0x5008000)
1812
1813			void
1814			check_HeUTF8(utf8_key)
1815			SV *utf8_key;
1816			PREINIT:
1817			HV *hash;
1818			HE *ent;
1819			STRLEN klen;
1820			char *key;
1821			PPCODE:
1822	2		hash = newHV();
1823
1824	2	50	key = SvPV(utf8_key, klen);
1825	2	100	if (SvUTF8(utf8_key)) klen *= -1;
1826	2		hv_store(hash, key, klen, newSVpvs("string"), 0);
1827	2		hv_iterinit(hash);
1828	2		ent = hv_iternext(hash);
1829			assert(ent);
1830	2	50	mXPUSHp((HeUTF8(ent) == 0 ? "norm" : "utf8"), 4);
		50
		100
1831	2		hv_undef(hash);
1832
1833
1834			#endif
1835
1836			void
1837			check_c_array()
1838			PREINIT:
1839	1		int x[] = { 10, 11, 12, 13 };
1840			PPCODE:
1841	1	50	mXPUSHi(C_ARRAY_LENGTH(x)); /* 4 */
1842	1	50	mXPUSHi((C_ARRAY_END(x)-1)); / 13 */
1843
1844			bool
1845			test_isBLANK(UV ord)
1846			CODE:
1847	2	50	RETVAL = isBLANK(ord);
		100
1848			OUTPUT:
1849			RETVAL
1850
1851			bool
1852			test_isBLANK_A(UV ord)
1853			CODE:
1854	2	50	RETVAL = isBLANK_A(ord);
		100
1855			OUTPUT:
1856			RETVAL
1857
1858			bool
1859			test_isUPPER(UV ord)
1860			CODE:
1861	2	50	RETVAL = isUPPER(ord);
		100
1862			OUTPUT:
1863			RETVAL
1864
1865			bool
1866			test_isUPPER_A(UV ord)
1867			CODE:
1868	3	50	RETVAL = isUPPER_A(ord);
		100
1869			OUTPUT:
1870			RETVAL
1871
1872			bool
1873			test_isLOWER(UV ord)
1874			CODE:
1875	2	50	RETVAL = isLOWER(ord);
		100
1876			OUTPUT:
1877			RETVAL
1878
1879			bool
1880			test_isLOWER_A(UV ord)
1881			CODE:
1882	3	50	RETVAL = isLOWER_A(ord);
		100
1883			OUTPUT:
1884			RETVAL
1885
1886			bool
1887			test_isALPHA(UV ord)
1888			CODE:
1889	2	50	RETVAL = isALPHA(ord);
		100
1890			OUTPUT:
1891			RETVAL
1892
1893			bool
1894			test_isALPHA_A(UV ord)
1895			CODE:
1896	2	50	RETVAL = isALPHA_A(ord);
		100
1897			OUTPUT:
1898			RETVAL
1899
1900			bool
1901			test_isWORDCHAR(UV ord)
1902			CODE:
1903	2	50	RETVAL = isWORDCHAR(ord);
		100
1904			OUTPUT:
1905			RETVAL
1906
1907			bool
1908			test_isWORDCHAR_A(UV ord)
1909			CODE:
1910	2	50	RETVAL = isWORDCHAR_A(ord);
		100
1911			OUTPUT:
1912			RETVAL
1913
1914			bool
1915			test_isALPHANUMERIC(UV ord)
1916			CODE:
1917	2	50	RETVAL = isALPHANUMERIC(ord);
		100
1918			OUTPUT:
1919			RETVAL
1920
1921			bool
1922			test_isALPHANUMERIC_A(UV ord)
1923			CODE:
1924	2	50	RETVAL = isALPHANUMERIC_A(ord);
		100
1925			OUTPUT:
1926			RETVAL
1927
1928			bool
1929			test_isALNUM(UV ord)
1930			CODE:
1931	2	50	RETVAL = isALNUM(ord);
		100
1932			OUTPUT:
1933			RETVAL
1934
1935			bool
1936			test_isALNUM_A(UV ord)
1937			CODE:
1938	2	50	RETVAL = isALNUM_A(ord);
		100
1939			OUTPUT:
1940			RETVAL
1941
1942			bool
1943			test_isDIGIT(UV ord)
1944			CODE:
1945	2	50	RETVAL = isDIGIT(ord);
		100
1946			OUTPUT:
1947			RETVAL
1948
1949			bool
1950			test_isDIGIT_A(UV ord)
1951			CODE:
1952	2	50	RETVAL = isDIGIT_A(ord);
		100
1953			OUTPUT:
1954			RETVAL
1955
1956			bool
1957			test_isOCTAL(UV ord)
1958			CODE:
1959	2		RETVAL = isOCTAL(ord);
1960			OUTPUT:
1961			RETVAL
1962
1963			bool
1964			test_isOCTAL_A(UV ord)
1965			CODE:
1966	2		RETVAL = isOCTAL_A(ord);
1967			OUTPUT:
1968			RETVAL
1969
1970			bool
1971			test_isIDFIRST(UV ord)
1972			CODE:
1973	2	50	RETVAL = isIDFIRST(ord);
		100
1974			OUTPUT:
1975			RETVAL
1976
1977			bool
1978			test_isIDFIRST_A(UV ord)
1979			CODE:
1980	2	50	RETVAL = isIDFIRST_A(ord);
		100
1981			OUTPUT:
1982			RETVAL
1983
1984			bool
1985			test_isIDCONT(UV ord)
1986			CODE:
1987	2	50	RETVAL = isIDCONT(ord);
		100
1988			OUTPUT:
1989			RETVAL
1990
1991			bool
1992			test_isIDCONT_A(UV ord)
1993			CODE:
1994	2	50	RETVAL = isIDCONT_A(ord);
		100
1995			OUTPUT:
1996			RETVAL
1997
1998			bool
1999			test_isSPACE(UV ord)
2000			CODE:
2001	2	50	RETVAL = isSPACE(ord);
		100
2002			OUTPUT:
2003			RETVAL
2004
2005			bool
2006			test_isSPACE_A(UV ord)
2007			CODE:
2008	2	50	RETVAL = isSPACE_A(ord);
		100
2009			OUTPUT:
2010			RETVAL
2011
2012			bool
2013			test_isASCII(UV ord)
2014			CODE:
2015	2		RETVAL = isASCII(ord);
2016			OUTPUT:
2017			RETVAL
2018
2019			bool
2020			test_isASCII_A(UV ord)
2021			CODE:
2022	2		RETVAL = isASCII_A(ord);
2023			OUTPUT:
2024			RETVAL
2025
2026			bool
2027			test_isCNTRL(UV ord)
2028			CODE:
2029	2	50	RETVAL = isCNTRL(ord);
		100
2030			OUTPUT:
2031			RETVAL
2032
2033			bool
2034			test_isCNTRL_A(UV ord)
2035			CODE:
2036	2	50	RETVAL = isCNTRL_A(ord);
		100
2037			OUTPUT:
2038			RETVAL
2039
2040			bool
2041			test_isPRINT(UV ord)
2042			CODE:
2043	2	50	RETVAL = isPRINT(ord);
		100
2044			OUTPUT:
2045			RETVAL
2046
2047			bool
2048			test_isPRINT_A(UV ord)
2049			CODE:
2050	2	50	RETVAL = isPRINT_A(ord);
		100
2051			OUTPUT:
2052			RETVAL
2053
2054			bool
2055			test_isGRAPH(UV ord)
2056			CODE:
2057	2	50	RETVAL = isGRAPH(ord);
		100
2058			OUTPUT:
2059			RETVAL
2060
2061			bool
2062			test_isGRAPH_A(UV ord)
2063			CODE:
2064	2	50	RETVAL = isGRAPH_A(ord);
		100
2065			OUTPUT:
2066			RETVAL
2067
2068			bool
2069			test_isPUNCT(UV ord)
2070			CODE:
2071	2	50	RETVAL = isPUNCT(ord);
		100
2072			OUTPUT:
2073			RETVAL
2074
2075			bool
2076			test_isPUNCT_A(UV ord)
2077			CODE:
2078	2	50	RETVAL = isPUNCT_A(ord);
		100
2079			OUTPUT:
2080			RETVAL
2081
2082			bool
2083			test_isXDIGIT(UV ord)
2084			CODE:
2085	2	50	RETVAL = isXDIGIT(ord);
		100
2086			OUTPUT:
2087			RETVAL
2088
2089			bool
2090			test_isXDIGIT_A(UV ord)
2091			CODE:
2092	2	50	RETVAL = isXDIGIT_A(ord);
		100
2093			OUTPUT:
2094			RETVAL
2095
2096			bool
2097			test_isPSXSPC(UV ord)
2098			CODE:
2099	2	50	RETVAL = isPSXSPC(ord);
		100
2100			OUTPUT:
2101			RETVAL
2102
2103			bool
2104			test_isPSXSPC_A(UV ord)
2105			CODE:
2106	2	50	RETVAL = isPSXSPC_A(ord);
		100
2107			OUTPUT:
2108			RETVAL
2109
2110			STRLEN
2111			av_tindex(av)
2112			AV *av
2113			CODE:
2114	1		RETVAL = av_tindex(av);
2115			OUTPUT:
2116			RETVAL
2117
2118			STRLEN
2119			av_top_index(av)
2120			AV *av
2121			CODE:
2122	1		RETVAL = av_top_index(av);
2123			OUTPUT:
2124			RETVAL
2125
2126			##----------------------------------------------------------------------
2127			## XSUBs for testing the implementation in parts/inc/newCONSTSUB
2128			##----------------------------------------------------------------------
2129
2130			void
2131			call_newCONSTSUB_1()
2132
2133			void
2134			call_newCONSTSUB_2()
2135
2136			void
2137			call_newCONSTSUB_3()
2138
2139			##----------------------------------------------------------------------
2140			## XSUBs for testing the implementation in parts/inc/newRV
2141			##----------------------------------------------------------------------
2142
2143			U32
2144			newRV_inc_REFCNT()
2145			PREINIT:
2146			SV sv, rv;
2147			CODE:
2148	1		sv = newSViv(42);
2149	1		rv = newRV_inc(sv);
2150	1		SvREFCNT_dec(sv);
2151	1		RETVAL = SvREFCNT(sv);
2152	1		sv_2mortal(rv);
2153			OUTPUT:
2154			RETVAL
2155
2156			U32
2157			newRV_noinc_REFCNT()
2158			PREINIT:
2159			SV sv, rv;
2160			CODE:
2161	1		sv = newSViv(42);
2162	1		rv = newRV_noinc(sv);
2163	1		RETVAL = SvREFCNT(sv);
2164	1		sv_2mortal(rv);
2165			OUTPUT:
2166			RETVAL
2167
2168			##----------------------------------------------------------------------
2169			## XSUBs for testing the implementation in parts/inc/newSV_type
2170			##----------------------------------------------------------------------
2171
2172			int
2173			newSV_type()
2174			PREINIT:
2175			SV* sv;
2176			CODE:
2177	1		RETVAL = 0;
2178	1		sv = newSV_type(SVt_NULL);
2179	1	50	if (SvTYPE(sv) == SVt_NULL)
2180			{
2181	1		RETVAL++;
2182			}
2183	1		SvREFCNT_dec(sv);
2184
2185	1		sv = newSV_type(SVt_PVIV);
2186	1	50	if (SvTYPE(sv) == SVt_PVIV)
2187			{
2188	1		RETVAL++;
2189			}
2190	1		SvREFCNT_dec(sv);
2191
2192	1		sv = newSV_type(SVt_PVHV);
2193	1	50	if (SvTYPE(sv) == SVt_PVHV)
2194			{
2195	1		RETVAL++;
2196			}
2197	1		SvREFCNT_dec(sv);
2198
2199	1		sv = newSV_type(SVt_PVAV);
2200	1	50	if (SvTYPE(sv) == SVt_PVAV)
2201			{
2202	1		RETVAL++;
2203			}
2204	1		SvREFCNT_dec(sv);
2205			OUTPUT:
2206			RETVAL
2207
2208			##----------------------------------------------------------------------
2209			## XSUBs for testing the implementation in parts/inc/newSVpv
2210			##----------------------------------------------------------------------
2211
2212			void
2213			newSVpvn()
2214			PPCODE:
2215	1	50	mXPUSHs(newSVpvn("test", 4));
2216	1	50	mXPUSHs(newSVpvn("test", 2));
2217	1	50	mXPUSHs(newSVpvn("test", 0));
2218	1	50	mXPUSHs(newSVpvn(NULL, 2));
2219	1	50	mXPUSHs(newSVpvn(NULL, 0));
2220	1		XSRETURN(5);
2221
2222			void
2223			newSVpvn_flags()
2224			PPCODE:
2225	1	50	XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP));
2226	1	50	XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP));
2227	1	50	XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP));
2228	1	50	XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP));
2229	1	50	XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP));
2230	1		XSRETURN(5);
2231
2232			void
2233			newSVpvn_utf8()
2234			PPCODE:
2235	1	50	XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP\|SVf_UTF8));
2236	1		XSRETURN(1);
2237
2238			##----------------------------------------------------------------------
2239			## XSUBs for testing the implementation in parts/inc/pv_tools
2240			##----------------------------------------------------------------------
2241
2242			void
2243			pv_escape_can_unicode()
2244			PPCODE:
2245			#if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
2246	1		XSRETURN_YES;
2247			#else
2248			XSRETURN_NO;
2249			#endif
2250
2251			void
2252			pv_pretty()
2253			PREINIT:
2254			char *rv;
2255			PPCODE:
2256	1	50	EXTEND(SP, 8);
2257	1		ST(0) = sv_newmortal();
2258	1		rv = pv_pretty(ST(0), "foobarbaz",
2259			9, 40, NULL, NULL, 0);
2260	1		ST(1) = sv_2mortal(newSVpv(rv, 0));
2261	1		ST(2) = sv_newmortal();
2262	1		rv = pv_pretty(ST(2), "pv_p\retty\n",
2263			10, 40, "left", "right", PERL_PV_PRETTY_LTGT);
2264	1		ST(3) = sv_2mortal(newSVpv(rv, 0));
2265	1		ST(4) = sv_newmortal();
2266	1		rv = pv_pretty(ST(4), "N\303\275 Batter\303\255",
2267			12, 20, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT);
2268	1		ST(5) = sv_2mortal(newSVpv(rv, 0));
2269	1		ST(6) = sv_newmortal();
2270	1		rv = pv_pretty(ST(6), "\303\201g\303\246tis Byrjun",
2271			15, 18, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT\|PERL_PV_PRETTY_ELLIPSES);
2272	1		ST(7) = sv_2mortal(newSVpv(rv, 0));
2273	1		XSRETURN(8);
2274
2275			void
2276			pv_display()
2277			PREINIT:
2278			char *rv;
2279			PPCODE:
2280	1	50	EXTEND(SP, 4);
2281	1		ST(0) = sv_newmortal();
2282	1		rv = pv_display(ST(0), "foob\0rbaz", 9, 10, 20);
2283	1		ST(1) = sv_2mortal(newSVpv(rv, 0));
2284	1		ST(2) = sv_newmortal();
2285	1		rv = pv_display(ST(2), "pv_display", 10, 11, 5);
2286	1		ST(3) = sv_2mortal(newSVpv(rv, 0));
2287	1		XSRETURN(4);
2288
2289			##----------------------------------------------------------------------
2290			## XSUBs for testing the implementation in parts/inc/pvs
2291			##----------------------------------------------------------------------
2292
2293			void
2294			newSVpvs()
2295			PPCODE:
2296	1	50	mXPUSHs(newSVpvs("newSVpvs"));
2297	1		XSRETURN(1);
2298
2299			void
2300			newSVpvs_flags()
2301			PPCODE:
2302	1	50	XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP));
2303	1		XSRETURN(1);
2304
2305			int
2306			newSVpvs_share()
2307			PREINIT:
2308			SV *sv;
2309			U32 hash;
2310			CODE:
2311	1		RETVAL = 0;
2312	1		PERL_HASH(hash, "pvs", 3);
2313	1		sv = newSVpvs_share("pvs");
2314	1	50	RETVAL += strEQ(SvPV_nolen_const(sv), "pvs");
2315	1		RETVAL += SvCUR(sv) == 3;
2316	1		RETVAL += SvSHARED_HASH(sv) == hash;
2317	1		SvREFCNT_dec(sv);
2318			OUTPUT:
2319			RETVAL
2320
2321			void
2322			sv_catpvs(sv)
2323			SV *sv
2324			PPCODE:
2325	1		sv_catpvs(sv, "sv_catpvs");
2326
2327			void
2328			sv_setpvs(sv)
2329			SV *sv
2330			PPCODE:
2331	1		sv_setpvs(sv, "sv_setpvs");
2332
2333			void
2334			hv_fetchs(hv)
2335			SV *hv
2336			PREINIT:
2337			SV **s;
2338			PPCODE:
2339	1		s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0);
2340	1	50	XPUSHs(sv_mortalcopy(*s));
2341	1		XSRETURN(1);
2342
2343			void
2344			hv_stores(hv, sv)
2345			SV *hv
2346			SV *sv
2347			PPCODE:
2348	1		(void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv));
2349
2350			SV*
2351			gv_fetchpvs()
2352			CODE:
2353	1		RETVAL = newRV_inc((SV*)gv_fetchpvs("Devel::PPPort::VERSION", 0, SVt_PV));
2354			OUTPUT:
2355			RETVAL
2356
2357			SV*
2358			gv_stashpvs()
2359			CODE:
2360	1		RETVAL = newRV_inc((SV*)gv_stashpvs("Devel::PPPort", 0));
2361			OUTPUT:
2362			RETVAL
2363
2364			int
2365			get_cvs()
2366			PREINIT:
2367			CV* xv;
2368			CODE:
2369	1		RETVAL = 0;
2370	1		xv = get_cvs("Devel::PPPort::foobar", 0);
2371	1	50	if(xv == NULL) RETVAL++;
2372	1		xv = get_cvs("Devel::PPPort::foobar", GV_ADDMULTI);
2373	1	50	if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
		50
2374	1		xv = get_cvs("Devel::PPPort::get_cvs", 0);
2375	1	50	if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
		50
2376			OUTPUT:
2377			RETVAL
2378
2379			##----------------------------------------------------------------------
2380			## XSUBs for testing the implementation in parts/inc/shared_pv
2381			##----------------------------------------------------------------------
2382
2383			int
2384			newSVpvn_share()
2385			PREINIT:
2386			const char *s;
2387			SV *sv;
2388			STRLEN len;
2389			U32 hash;
2390			CODE:
2391	1		RETVAL = 0;
2392	1		s = "mhx";
2393	1		len = 3;
2394	1		PERL_HASH(hash, (char *) s, len);
2395	1		sv = newSVpvn_share(s, len, 0);
2396	1		s = 0;
2397	1	50	RETVAL += strEQ(SvPV_nolen_const(sv), "mhx");
2398	1		RETVAL += SvCUR(sv) == len;
2399	1		RETVAL += SvSHARED_HASH(sv) == hash;
2400	1		SvREFCNT_dec(sv);
2401	1		s = "foobar";
2402	1		len = 6;
2403	1		PERL_HASH(hash, (char *) s, len);
2404	1		sv = newSVpvn_share(s, -(I32) len, hash);
2405	1		s = 0;
2406	1	50	RETVAL += strEQ(SvPV_nolen_const(sv), "foobar");
2407	1		RETVAL += SvCUR(sv) == len;
2408	1		RETVAL += SvSHARED_HASH(sv) == hash;
2409	1		SvREFCNT_dec(sv);
2410			OUTPUT:
2411			RETVAL
2412
2413			##----------------------------------------------------------------------
2414			## XSUBs for testing the implementation in parts/inc/snprintf
2415			##----------------------------------------------------------------------
2416
2417			void
2418			my_snprintf()
2419			PREINIT:
2420			char buf[128];
2421			int len;
2422			PPCODE:
2423	1	50	len = my_snprintf(buf, sizeof buf, "foo%s%d", "bar", 42);
2424	1	50	mXPUSHi(len);
2425	1	50	mXPUSHs(newSVpv(buf, 0));
2426	1		XSRETURN(2);
2427
2428			##----------------------------------------------------------------------
2429			## XSUBs for testing the implementation in parts/inc/sprintf
2430			##----------------------------------------------------------------------
2431
2432			void
2433			my_sprintf()
2434			PREINIT:
2435			char buf[128];
2436			int len;
2437			PPCODE:
2438	1		len = my_sprintf(buf, "foo%s%d", "bar", 42);
2439	1	50	mXPUSHi(len);
2440	1	50	mXPUSHs(newSVpv(buf, 0));
2441	1		XSRETURN(2);
2442
2443			##----------------------------------------------------------------------
2444			## XSUBs for testing the implementation in parts/inc/strlfuncs
2445			##----------------------------------------------------------------------
2446
2447			void
2448			my_strlfunc()
2449			PREINIT:
2450			char buf[8];
2451			int len;
2452			PPCODE:
2453	1		len = my_strlcpy(buf, "foo", sizeof(buf));
2454	1	50	mXPUSHi(len);
2455	1	50	mXPUSHs(newSVpv(buf, 0));
2456	1		len = my_strlcat(buf, "bar", sizeof(buf));
2457	1	50	mXPUSHi(len);
2458	1	50	mXPUSHs(newSVpv(buf, 0));
2459	1		len = my_strlcat(buf, "baz", sizeof(buf));
2460	1	50	mXPUSHi(len);
2461	1	50	mXPUSHs(newSVpv(buf, 0));
2462	1		len = my_strlcpy(buf, "1234567890", sizeof(buf));
2463	1	50	mXPUSHi(len);
2464	1	50	mXPUSHs(newSVpv(buf, 0));
2465	1		len = my_strlcpy(buf, "1234", sizeof(buf));
2466	1	50	mXPUSHi(len);
2467	1	50	mXPUSHs(newSVpv(buf, 0));
2468	1		len = my_strlcat(buf, "567890123456", sizeof(buf));
2469	1	50	mXPUSHi(len);
2470	1	50	mXPUSHs(newSVpv(buf, 0));
2471	1		XSRETURN(12);
2472
2473			##----------------------------------------------------------------------
2474			## XSUBs for testing the implementation in parts/inc/sv_xpvf
2475			##----------------------------------------------------------------------
2476
2477			SV *
2478			vnewSVpvf()
2479			CODE:
2480	1		RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
2481			OUTPUT:
2482			RETVAL
2483
2484			SV *
2485			sv_vcatpvf(sv)
2486			SV *sv
2487			CODE:
2488	1		RETVAL = newSVsv(sv);
2489	1		test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
2490			OUTPUT:
2491			RETVAL
2492
2493			SV *
2494			sv_vsetpvf(sv)
2495			SV *sv
2496			CODE:
2497	1		RETVAL = newSVsv(sv);
2498	1		test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
2499			OUTPUT:
2500			RETVAL
2501
2502			void
2503			sv_catpvf_mg(sv)
2504			SV *sv
2505			CODE:
2506			#if (PERL_BCDVERSION >= 0x5004000)
2507	1		sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
2508			#endif
2509
2510			void
2511			Perl_sv_catpvf_mg(sv)
2512			SV *sv
2513			CODE:
2514			#if (PERL_BCDVERSION >= 0x5004000)
2515	1		Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
2516			#endif
2517
2518			void
2519			sv_catpvf_mg_nocontext(sv)
2520			SV *sv
2521			CODE:
2522			#if (PERL_BCDVERSION >= 0x5004000)
2523			#ifdef PERL_IMPLICIT_CONTEXT
2524			sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
2525			#else
2526	1		sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
2527			#endif
2528			#endif
2529
2530			void
2531			sv_setpvf_mg(sv)
2532			SV *sv
2533			CODE:
2534			#if (PERL_BCDVERSION >= 0x5004000)
2535	1		sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
2536			#endif
2537
2538			void
2539			Perl_sv_setpvf_mg(sv)
2540			SV *sv
2541			CODE:
2542			#if (PERL_BCDVERSION >= 0x5004000)
2543	1		Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
2544			#endif
2545
2546			void
2547			sv_setpvf_mg_nocontext(sv)
2548			SV *sv
2549			CODE:
2550			#if (PERL_BCDVERSION >= 0x5004000)
2551			#ifdef PERL_IMPLICIT_CONTEXT
2552			sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
2553			#else
2554	1		sv_setpvf_mg(sv, "%s-%d", "bar", 44);
2555			#endif
2556			#endif
2557
2558			##----------------------------------------------------------------------
2559			## XSUBs for testing the implementation in parts/inc/threads
2560			##----------------------------------------------------------------------
2561
2562			IV
2563			no_THX_arg(sv)
2564			SV *sv
2565			CODE:
2566	1		RETVAL = 1 + sv_2iv(sv);
2567			OUTPUT:
2568			RETVAL
2569
2570			void
2571			with_THX_arg(error)
2572			SV *error
2573			PPCODE:
2574	1		croak_sv(error);
2575
2576			##----------------------------------------------------------------------
2577			## XSUBs for testing the implementation in parts/inc/uv
2578			##----------------------------------------------------------------------
2579
2580			SV *
2581			sv_setuv(uv)
2582			UV uv
2583			CODE:
2584	1		RETVAL = newSViv(1);
2585	1		sv_setuv(RETVAL, uv);
2586			OUTPUT:
2587			RETVAL
2588
2589			SV *
2590			newSVuv(uv)
2591			UV uv
2592			CODE:
2593	1		RETVAL = newSVuv(uv);
2594			OUTPUT:
2595			RETVAL
2596
2597			UV
2598			sv_2uv(sv)
2599			SV *sv
2600			CODE:
2601	2		RETVAL = sv_2uv(sv);
2602			OUTPUT:
2603			RETVAL
2604
2605			UV
2606			SvUVx(sv)
2607			SV *sv
2608			CODE:
2609	3		sv--;
2610	3	50	RETVAL = SvUVx(++sv);
2611			OUTPUT:
2612			RETVAL
2613
2614			void
2615			XSRETURN_UV()
2616			PPCODE:
2617	1		XSRETURN_UV(42);
2618
2619			void
2620			PUSHu()
2621			PREINIT:
2622			dTARG;
2623			PPCODE:
2624	1		TARG = sv_newmortal();
2625	1	50	EXTEND(SP, 1);
2626	1	50	PUSHu(42);
2627	1		XSRETURN(1);
2628
2629			void
2630			XPUSHu()
2631			PREINIT:
2632			dTARG;
2633			PPCODE:
2634	1		TARG = sv_newmortal();
2635	1	50	XPUSHu(43);
		50
2636	1		XSRETURN(1);
2637
2638			STRLEN
2639			UTF8_SAFE_SKIP(s, adjustment)
2640			unsigned char * s
2641			int adjustment
2642			CODE:
2643			/* Instead of passing in an 'e' ptr, use the real end, adjusted */
2644	2	100	RETVAL = UTF8_SAFE_SKIP(s, s + UTF8SKIP(s) + adjustment);
2645			OUTPUT:
2646			RETVAL
2647
2648			STRLEN
2649			my_strnlen(s, max)
2650			char * s
2651			STRLEN max
2652			CODE:
2653	1		RETVAL= my_strnlen(s, max);
2654			OUTPUT:
2655			RETVAL
2656
2657			AV *
2658			utf8_to_uvchr_buf(s, adjustment)
2659			unsigned char *s
2660			int adjustment
2661			PREINIT:
2662			AV *av;
2663			STRLEN len;
2664			CODE:
2665	13		av = newAV();
2666	13		av_push(av, newSVuv(utf8_to_uvchr_buf(s,
2667			s + UTF8SKIP(s) + adjustment,
2668			&len)));
2669	13	100	if (len == (STRLEN) -1) {
2670	5		av_push(av, newSViv(-1));
2671			}
2672			else {
2673	8		av_push(av, newSVuv(len));
2674			}
2675	13		RETVAL = av;
2676			OUTPUT:
2677			RETVAL
2678
2679			AV *
2680			utf8_to_uvchr(s)
2681			unsigned char *s
2682			PREINIT:
2683			AV *av;
2684			STRLEN len;
2685			CODE:
2686	4		av = newAV();
2687	4	100	av_push(av, newSVuv(utf8_to_uvchr(s, &len)));
2688	4	100	if (len == (STRLEN) -1) {
2689	1		av_push(av, newSViv(-1));
2690			}
2691			else {
2692	3		av_push(av, newSVuv(len));
2693			}
2694	4		RETVAL = av;
2695			OUTPUT:
2696			RETVAL
2697
2698			##----------------------------------------------------------------------
2699			## XSUBs for testing the implementation in parts/inc/variables
2700			##----------------------------------------------------------------------
2701
2702			int
2703			compare_PL_signals()
2704			CODE:
2705			{
2706	1		U32 ref = get_PL_signals_1();
2707	1	50	RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
		50
2708			}
2709			OUTPUT:
2710			RETVAL
2711
2712			SV *
2713			PL_sv_undef()
2714			CODE:
2715	1		RETVAL = newSVsv(&PL_sv_undef);
2716			OUTPUT:
2717			RETVAL
2718
2719			SV *
2720			PL_sv_yes()
2721			CODE:
2722	1		RETVAL = newSVsv(&PL_sv_yes);
2723			OUTPUT:
2724			RETVAL
2725
2726			SV *
2727			PL_sv_no()
2728			CODE:
2729	1		RETVAL = newSVsv(&PL_sv_no);
2730			OUTPUT:
2731			RETVAL
2732
2733			int
2734			PL_na(string)
2735			char *string
2736			CODE:
2737	1		PL_na = strlen(string);
2738	1		RETVAL = PL_na;
2739			OUTPUT:
2740			RETVAL
2741
2742			SV *
2743			PL_Sv()
2744			CODE:
2745	1		PL_Sv = newSVpv("mhx", 0);
2746	1		RETVAL = PL_Sv;
2747			OUTPUT:
2748			RETVAL
2749
2750			SV *
2751			PL_tokenbuf()
2752			CODE:
2753	1	50	RETVAL = newSViv(PL_tokenbuf[0]);
2754			OUTPUT:
2755			RETVAL
2756
2757			SV *
2758			PL_parser()
2759			CODE:
2760	0		RETVAL = newSViv(PL_parser != NULL);
2761			OUTPUT:
2762			RETVAL
2763
2764			SV *
2765			PL_hexdigit()
2766			CODE:
2767	1		RETVAL = newSVpv((char *) PL_hexdigit, 0);
2768			OUTPUT:
2769			RETVAL
2770
2771			SV *
2772			PL_hints()
2773			CODE:
2774	1		RETVAL = newSViv((IV) PL_hints);
2775			OUTPUT:
2776			RETVAL
2777
2778			void
2779			PL_ppaddr(string)
2780			char *string
2781			PPCODE:
2782	1	50	PUSHMARK(SP);
2783	1	50	mXPUSHs(newSVpv(string, 0));
2784	1		PUTBACK;
2785	1		ENTER;
2786	1		(void)*(PL_ppaddr[OP_UC])(aTHXR);
2787	1		SPAGAIN;
2788	1		LEAVE;
2789	1		XSRETURN(1);
2790
2791			void
2792			other_variables()
2793			PREINIT:
2794	1		int count = 0;
2795			PPCODE:
2796	1	50	ppp_TESTVAR(PL_DBsignal);
2797	1	50	ppp_TESTVAR(PL_DBsingle);
2798	1	50	ppp_TESTVAR(PL_DBsub);
2799	1	50	ppp_TESTVAR(PL_DBtrace);
2800	1	50	ppp_TESTVAR(PL_compiling);
2801	1	50	ppp_TESTVAR(PL_curcop);
2802	1	50	ppp_TESTVAR(PL_curstash);
2803	1	50	ppp_TESTVAR(PL_debstash);
2804	1	50	ppp_TESTVAR(PL_defgv);
2805	1	50	ppp_TESTVAR(PL_diehook);
2806			#if (PERL_BCDVERSION >= 0x5013007)
2807			/* can't get a pointer any longer */
2808	1	50	mXPUSHi(PL_dirty ? 1 : 1);
2809	1		count++;
2810			#else
2811			ppp_TESTVAR(PL_dirty);
2812			#endif
2813	1	50	ppp_TESTVAR(PL_dowarn);
2814	1	50	ppp_TESTVAR(PL_errgv);
2815	1	50	ppp_TESTVAR(PL_laststatval);
2816	1	50	ppp_TESTVAR(PL_no_modify);
2817	1	50	ppp_TESTVAR(PL_perl_destruct_level);
2818	1	50	ppp_TESTVAR(PL_perldb);
2819	1	50	ppp_TESTVAR(PL_stack_base);
2820	1	50	ppp_TESTVAR(PL_stack_sp);
2821	1	50	ppp_TESTVAR(PL_statcache);
2822	1	50	ppp_TESTVAR(PL_stdingv);
2823	1	50	ppp_TESTVAR(PL_sv_arenaroot);
2824	1	50	ppp_TESTVAR(PL_tainted);
2825	1	50	ppp_TESTVAR(PL_tainting);
2826
2827	1	50	ppp_PARSERVAR(ppp_expect_t, PL_expect);
		50
		50
		50
		50
		50
2828	1	50	ppp_PARSERVAR(line_t, PL_copline);
		50
		50
		50
		50
		50
2829	1	50	ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp);
		50
		50
		50
		50
		50
2830	1	50	ppp_PARSERVAR(AV *, PL_rsfp_filters);
		50
		50
		50
		50
		50
2831	1	50	ppp_PARSERVAR(SV *, PL_linestr);
		50
		50
		50
		50
		50
2832	1	50	ppp_PARSERVAR(char *, PL_bufptr);
		50
		50
		50
		50
		50
2833	1	50	ppp_PARSERVAR(char *, PL_bufend);
		50
		50
		50
		50
		50
2834	1	50	ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state);
		50
		50
		50
		50
		50
2835	1	50	ppp_PARSERVAR(SV *, PL_lex_stuff);
		50
		50
		50
		50
		50
2836	1	50	ppp_PARSERVAR(ppp_error_count_t, PL_error_count);
		50
		50
		50
		50
		50
2837	1	50	ppp_PARSERVAR(ppp_in_my_t, PL_in_my);
		50
		50
		50
		50
		50
2838			#if (PERL_BCDVERSION >= 0x5005000)
2839	1	50	ppp_PARSERVAR(HV*, PL_in_my_stash);
		50
		50
		50
		50
		50
2840			#else
2841			ppp_PARSERVAR_dummy;
2842			#endif
2843	1		XSRETURN(count);
2844
2845			int
2846			no_dummy_parser_vars(check)
2847			int check
2848
2849			int
2850			dummy_parser_warning()
2851
2852			##----------------------------------------------------------------------
2853			## XSUBs for testing the implementation in parts/inc/warn
2854			##----------------------------------------------------------------------
2855
2856			void
2857			warner()
2858			CODE:
2859			#if (PERL_BCDVERSION >= 0x5004000)
2860	1		warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42);
2861			#endif
2862
2863			void
2864			Perl_warner()
2865			CODE:
2866			#if (PERL_BCDVERSION >= 0x5004000)
2867	1		Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42);
2868			#endif
2869
2870			void
2871			Perl_warner_nocontext()
2872			CODE:
2873			#if (PERL_BCDVERSION >= 0x5004000)
2874	1		Perl_warner_nocontext(packWARN(WARN_MISC), "Perl_warner_nocontext %s:%d", "bar", 42);
2875			#endif
2876
2877			void
2878			ckWARN()
2879			CODE:
2880			#if (PERL_BCDVERSION >= 0x5004000)
2881	2	100	if (ckWARN(WARN_MISC))
2882	1		Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42);
2883			#endif