File Coverage

RealPPPort.xs

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