File Coverage

RealPPPort.xs

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