This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
We don't provide GCC_BRACE_GROUPS_FORBIDDEND
[perl5.git] / dist / Devel-PPPort / parts / inc / misc
CommitLineData
adfe19db
MHM
1################################################################################
2##
b2049988 3## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
adfe19db
MHM
4## Version 2.x, Copyright (C) 2001, Paul Marquess.
5## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
6##
7## This program is free software; you can redistribute it and/or
8## modify it under the same terms as Perl itself.
9##
10################################################################################
11
12=provides
13
14__UNDEFINED__
f2615e36
KW
15END_EXTERN_C
16EXTERN_C
f2615e36
KW
17INT2PTR
18MUTABLE_PTR
f2615e36 19NVTYPE
f2615e36
KW
20PERLIO_FUNCS_CAST
21PERLIO_FUNCS_DECL
f2ab5a41 22PERL_UNUSED_ARG
f2ab5a41 23PERL_UNUSED_CONTEXT
f2615e36 24PERL_UNUSED_DECL
94e22bd6 25PERL_UNUSED_RESULT
f2615e36 26PERL_UNUSED_VAR
c07deaaf 27PERL_USE_GCC_BRACE_GROUPS
adfe19db 28PTR2ul
f2615e36 29PTRV
a745474a 30START_EXTERN_C
a745474a 31STMT_END
f2615e36
KW
32STMT_START
33SvRX
b2049988 34WIDEST_UTYPE
0d0f8426 35XSRETURN
adfe19db
MHM
36
37=implementation
38
94e22bd6
MH
39__UNDEFINED__ cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
40__UNDEFINED__ OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
41__UNDEFINED__ OpSIBLING(o) (0 + (o)->op_sibling)
42__UNDEFINED__ OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
43__UNDEFINED__ OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
44__UNDEFINED__ OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
58329f0d 45__UNDEFINED__ HEf_SVKEY -2
94e22bd6 46
6a6bfa62
KW
47#if defined(DEBUGGING) && !defined(__COVERITY__)
48__UNDEFINED__ __ASSERT_(statement) assert(statement),
49#else
50__UNDEFINED__ __ASSERT_(statement)
51#endif
52
e2e74bab 53__UNDEFINED__ SvRX(rv) (SvROK((rv)) ? (SvMAGICAL(SvRV((rv))) ? (mg_find(SvRV((rv)), PERL_MAGIC_qr) ? mg_find(SvRV((rv)), PERL_MAGIC_qr)->mg_obj : NULL) : NULL) : NULL)
94e22bd6
MH
54__UNDEFINED__ SvRXOK(sv) (!!SvRX(sv))
55
62093c1c
NC
56#ifndef PERL_UNUSED_DECL
57# ifdef HASATTRIBUTE
58# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
59# define PERL_UNUSED_DECL
60# else
61# define PERL_UNUSED_DECL __attribute__((unused))
62# endif
adfe19db 63# else
62093c1c 64# define PERL_UNUSED_DECL
adfe19db 65# endif
adfe19db
MHM
66#endif
67
f2ab5a41
MHM
68#ifndef PERL_UNUSED_ARG
69# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
70# include <note.h>
71# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
72# else
73# define PERL_UNUSED_ARG(x) ((void)x)
74# endif
75#endif
76
77#ifndef PERL_UNUSED_VAR
78# define PERL_UNUSED_VAR(x) ((void)x)
79#endif
80
81#ifndef PERL_UNUSED_CONTEXT
82# ifdef USE_ITHREADS
83# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
84# else
85# define PERL_UNUSED_CONTEXT
86# endif
87#endif
88
94e22bd6
MH
89#ifndef PERL_UNUSED_RESULT
90# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
91# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
92# else
93# define PERL_UNUSED_RESULT(v) ((void)(v))
94# endif
95#endif
96
f2ab5a41
MHM
97__UNDEFINED__ NOOP /*EMPTY*/(void)0
98__UNDEFINED__ dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
adfe19db
MHM
99
100#ifndef NVTYPE
101# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
102# define NVTYPE long double
103# else
104# define NVTYPE double
105# endif
106typedef NVTYPE NV;
107#endif
108
109#ifndef INT2PTR
adfe19db
MHM
110# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
111# define PTRV UV
112# define INT2PTR(any,d) (any)(d)
113# else
114# if PTRSIZE == LONGSIZE
115# define PTRV unsigned long
116# else
117# define PTRV unsigned
118# endif
119# define INT2PTR(any,d) (any)(PTRV)(d)
120# endif
7bb03b24 121#endif
adfe19db 122
7bb03b24 123#ifndef PTR2ul
adfe19db
MHM
124# if PTRSIZE == LONGSIZE
125# define PTR2ul(p) (unsigned long)(p)
126# else
4a582685 127# define PTR2ul(p) INT2PTR(unsigned long,p)
adfe19db 128# endif
7bb03b24 129#endif
adfe19db 130
7bb03b24
MHM
131__UNDEFINED__ PTR2nat(p) (PTRV)(p)
132__UNDEFINED__ NUM2PTR(any,d) (any)PTR2nat(d)
133__UNDEFINED__ PTR2IV(p) INT2PTR(IV,p)
134__UNDEFINED__ PTR2UV(p) INT2PTR(UV,p)
135__UNDEFINED__ PTR2NV(p) NUM2PTR(NV,p)
adfe19db 136
a745474a
MHM
137#undef START_EXTERN_C
138#undef END_EXTERN_C
139#undef EXTERN_C
140#ifdef __cplusplus
141# define START_EXTERN_C extern "C" {
142# define END_EXTERN_C }
143# define EXTERN_C extern "C"
144#else
145# define START_EXTERN_C
146# define END_EXTERN_C
147# define EXTERN_C extern
148#endif
149
0915d96d 150#if { VERSION < 5.004 } || defined(PERL_GCC_PEDANTIC)
c07deaaf 151# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
12b46422 152__UNDEF_NOT_PROVIDED__ PERL_GCC_BRACE_GROUPS_FORBIDDEN
a745474a
MHM
153# endif
154#endif
155
c07deaaf
MHM
156#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
157# ifndef PERL_USE_GCC_BRACE_GROUPS
158# define PERL_USE_GCC_BRACE_GROUPS
159# endif
160#endif
161
a745474a
MHM
162#undef STMT_START
163#undef STMT_END
c07deaaf 164#ifdef PERL_USE_GCC_BRACE_GROUPS
b2049988
MHM
165# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
166# define STMT_END )
a745474a
MHM
167#else
168# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
b2049988
MHM
169# define STMT_START if (1)
170# define STMT_END else (void)0
a745474a 171# else
b2049988
MHM
172# define STMT_START do
173# define STMT_END while (0)
a745474a
MHM
174# endif
175#endif
176
adfe19db
MHM
177__UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
178
179/* DEFSV appears first in 5.004_56 */
b2049988 180__UNDEFINED__ DEFSV GvSV(PL_defgv)
adfe19db 181__UNDEFINED__ SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
ac2e3cea 182__UNDEFINED__ DEFSV_set(sv) (DEFSV = (sv))
adfe19db
MHM
183
184/* Older perls (<=5.003) lack AvFILLp */
185__UNDEFINED__ AvFILLp AvFILL
186
1eff2a3b
KW
187__UNDEFINED__ av_tindex AvFILL
188__UNDEFINED__ av_top_index AvFILL
189
adfe19db
MHM
190__UNDEFINED__ ERRSV get_sv("@",FALSE)
191
adfe19db
MHM
192/* Hint: gv_stashpvn
193 * This function's backport doesn't support the length parameter, but
194 * rather ignores it. Portability can only be ensured if the length
195 * parameter is used for speed reasons, but the length can always be
196 * correctly computed from the string argument.
197 */
198
199__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create)
200
201/* Replace: 1 */
202__UNDEFINED__ get_cv perl_get_cv
203__UNDEFINED__ get_sv perl_get_sv
204__UNDEFINED__ get_av perl_get_av
205__UNDEFINED__ get_hv perl_get_hv
206/* Replace: 0 */
207
adfe19db
MHM
208__UNDEFINED__ dUNDERBAR dNOOP
209__UNDEFINED__ UNDERBAR DEFSV
210
211__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1
212__UNDEFINED__ dITEMS I32 items = SP - MARK
213
9132e1a3
MHM
214__UNDEFINED__ dXSTARG SV * targ = sv_newmortal()
215
0d0f8426
MHM
216__UNDEFINED__ dAXMARK I32 ax = POPMARK; \
217 register SV ** const mark = PL_stack_base + ax++
218
219
220__UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1)
221
222#if { VERSION < 5.005 }
223# undef XSRETURN
224# define XSRETURN(off) \
225 STMT_START { \
226 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
227 return; \
228 } STMT_END
229#endif
230
8565c31a
MHM
231__UNDEFINED__ XSPROTO(name) void name(pTHX_ CV* cv)
232__UNDEFINED__ SVfARG(p) ((void*)(p))
233
f2ab5a41
MHM
234__UNDEFINED__ PERL_ABS(x) ((x) < 0 ? -(x) : (x))
235
236__UNDEFINED__ dVAR dNOOP
237
238__UNDEFINED__ SVf "_"
239
fd7af155
MHM
240__UNDEFINED__ CPERLscope(x) x
241
c83e6f19 242__UNDEFINED__ PERL_HASH(hash,str,len) \
b2049988
MHM
243 STMT_START { \
244 const char *s_PeRlHaSh = str; \
245 I32 i_PeRlHaSh = len; \
246 U32 hash_PeRlHaSh = 0; \
247 while (i_PeRlHaSh--) \
248 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
249 (hash) = hash_PeRlHaSh; \
c83e6f19 250 } STMT_END
679ad62d 251
9c0a17a0
MHM
252#ifndef PERLIO_FUNCS_DECL
253# ifdef PERLIO_FUNCS_CONST
254# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
255# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
256# else
257# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
258# define PERLIO_FUNCS_CAST(funcs) (funcs)
259# endif
260#endif
261
fd7af155
MHM
262/* provide these typedefs for older perls */
263#if { VERSION < 5.9.3 }
264
265# ifdef ARGSproto
266typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
267# else
268typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
269# endif
270
271typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
272
273#endif
274
111bb900
CB
275#ifndef WIDEST_UTYPE
276# ifdef QUADKIND
277# ifdef U64TYPE
278# define WIDEST_UTYPE U64TYPE
279# else
280# define WIDEST_UTYPE Quad_t
281# endif
744ef08f 282# else
111bb900 283# define WIDEST_UTYPE U32
744ef08f 284# endif
b2049988
MHM
285#endif
286
150ac7cc
KW
287/* On versions without this, only ASCII is supported */
288#ifdef NATIVE_TO_ASCII
289__UNDEFINED__ NATIVE_TO_LATIN1(c) NATIVE_TO_ASCII(c)
290#else
291__UNDEFINED__ NATIVE_TO_LATIN1(c) (c)
292#endif
293
294#ifdef ASCII_TO_NATIVE
295__UNDEFINED__ LATIN1_TO_NATIVE(c) ASCII_TO_NATIVE(c)
296#else
297__UNDEFINED__ LATIN1_TO_NATIVE(c) (c)
298#endif
299
300/* Warning: LATIN1_TO_NATIVE, NATIVE_TO_LATIN1
301 EBCDIC is not supported on versions earlier than 5.7.1
302 */
303
9dc2cc38
KW
304#ifdef EBCDIC
305
e17f6823
KW
306/* This is the first version where these macros are fully correct on EBCDIC
307 * platforms. Relying on * the C library functions, as earlier releases did,
308 * causes problems with * locales */
9dc2cc38
KW
309# if { VERSION < 5.22.0 }
310# undef isALNUM
311# undef isALNUM_A
876aded1 312# undef isALNUM_L1
9dc2cc38
KW
313# undef isALNUMC
314# undef isALNUMC_A
876aded1 315# undef isALNUMC_L1
9dc2cc38
KW
316# undef isALPHA
317# undef isALPHA_A
876aded1 318# undef isALPHA_L1
9dc2cc38
KW
319# undef isALPHANUMERIC
320# undef isALPHANUMERIC_A
876aded1 321# undef isALPHANUMERIC_L1
9dc2cc38
KW
322# undef isASCII
323# undef isASCII_A
876aded1 324# undef isASCII_L1
9dc2cc38
KW
325# undef isBLANK
326# undef isBLANK_A
876aded1 327# undef isBLANK_L1
9dc2cc38
KW
328# undef isCNTRL
329# undef isCNTRL_A
876aded1 330# undef isCNTRL_L1
9dc2cc38
KW
331# undef isDIGIT
332# undef isDIGIT_A
876aded1 333# undef isDIGIT_L1
9dc2cc38
KW
334# undef isGRAPH
335# undef isGRAPH_A
876aded1 336# undef isGRAPH_L1
9dc2cc38
KW
337# undef isIDCONT
338# undef isIDCONT_A
876aded1 339# undef isIDCONT_L1
9dc2cc38
KW
340# undef isIDFIRST
341# undef isIDFIRST_A
876aded1 342# undef isIDFIRST_L1
9dc2cc38
KW
343# undef isLOWER
344# undef isLOWER_A
876aded1 345# undef isLOWER_L1
9dc2cc38
KW
346# undef isOCTAL
347# undef isOCTAL_A
876aded1 348# undef isOCTAL_L1
9dc2cc38
KW
349# undef isPRINT
350# undef isPRINT_A
876aded1 351# undef isPRINT_L1
9dc2cc38
KW
352# undef isPSXSPC
353# undef isPSXSPC_A
876aded1 354# undef isPSXSPC_L1
9dc2cc38
KW
355# undef isPUNCT
356# undef isPUNCT_A
876aded1 357# undef isPUNCT_L1
9dc2cc38
KW
358# undef isSPACE
359# undef isSPACE_A
876aded1 360# undef isSPACE_L1
9dc2cc38
KW
361# undef isUPPER
362# undef isUPPER_A
876aded1 363# undef isUPPER_L1
9dc2cc38
KW
364# undef isWORDCHAR
365# undef isWORDCHAR_A
876aded1 366# undef isWORDCHAR_L1
9dc2cc38
KW
367# undef isXDIGIT
368# undef isXDIGIT_A
876aded1 369# undef isXDIGIT_L1
9dc2cc38
KW
370# endif
371
372__UNDEFINED__ isASCII(c) (isCNTRL(c) || isPRINT(c))
373
374 /* The below is accurate for all EBCDIC code pages supported by
375 * all the versions of Perl overridden by this */
376__UNDEFINED__ isCNTRL(c) ( (c) == '\0' || (c) == '\a' || (c) == '\b' \
377 || (c) == '\f' || (c) == '\n' || (c) == '\r' \
378 || (c) == '\t' || (c) == '\v' \
379 || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */ \
380 || (c) == 7 /* U+7F DEL */ \
381 || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */ \
382 /* DLE, DC[1-3] */ \
383 || (c) == 0x18 /* U+18 CAN */ \
384 || (c) == 0x19 /* U+19 EOM */ \
385 || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */ \
386 || (c) == 0x26 /* U+17 ETB */ \
387 || (c) == 0x27 /* U+1B ESC */ \
388 || (c) == 0x2D /* U+05 ENQ */ \
389 || (c) == 0x2E /* U+06 ACK */ \
390 || (c) == 0x32 /* U+16 SYN */ \
391 || (c) == 0x37 /* U+04 EOT */ \
392 || (c) == 0x3C /* U+14 DC4 */ \
393 || (c) == 0x3D /* U+15 NAK */ \
394 || (c) == 0x3F /* U+1A SUB */ \
395 )
876aded1
KW
396
397#if '^' == 106 /* EBCDIC POSIX-BC */
398# define D_PPP_OUTLIER_CONTROL 0x5F
399#else /* EBCDIC 1047 037 */
400# define D_PPP_OUTLIER_CONTROL 0xFF
401#endif
402
403/* The controls are everything below blank, plus one outlier */
404__UNDEFINED__ isCNTRL_L1(c) ((WIDEST_UTYPE) (c) < ' ' \
405 || (WIDEST_UTYPE) (c) == D_PPP_OUTLIER_CONTROL)
406 )
9dc2cc38
KW
407/* The ordering of the tests in this and isUPPER are to exclude most characters
408 * early */
409__UNDEFINED__ isLOWER(c) ( (c) >= 'a' && (c) <= 'z' \
410 && ( (c) <= 'i' \
411 || ((c) >= 'j' && (c) <= 'r') \
412 || (c) >= 's'))
413__UNDEFINED__ isUPPER(c) ( (c) >= 'A' && (c) <= 'Z' \
414 && ( (c) <= 'I' \
415 || ((c) >= 'J' && (c) <= 'R') \
416 || (c) >= 'S'))
417
418#else /* Above is EBCDIC; below is ASCII */
419
420# if { VERSION < 5.4.0 }
421/* The implementation of these in older perl versions can give wrong results if
422 * the C program locale is set to other than the C locale */
423# undef isALNUM
424# undef isALNUM_A
425# undef isALPHA
426# undef isALPHA_A
427# undef isDIGIT
428# undef isDIGIT_A
429# undef isIDFIRST
430# undef isIDFIRST_A
431# undef isLOWER
432# undef isLOWER_A
433# undef isUPPER
434# undef isUPPER_A
435# endif
436
d7412c0a 437# if { VERSION < 5.8.0 } /* earlier perls omitted DEL */
9dc2cc38
KW
438# undef isCNTRL
439# endif
440
441# if { VERSION < 5.10.0 }
d7412c0a
KW
442/* earlier perls included all of the isSPACE() characters, which is wrong. The
443 * version provided by Devel::PPPort always overrides an existing buggy
444 * version. */
9dc2cc38
KW
445# undef isPRINT
446# undef isPRINT_A
447# endif
448
449# if { VERSION < 5.14.0 }
d7412c0a 450/* earlier perls always returned true if the parameter was a signed char */
9dc2cc38
KW
451# undef isASCII
452# undef isASCII_A
453# endif
454
876aded1
KW
455# if { VERSION < 5.17.8 } /* earlier perls didn't include PILCROW, SECTION SIGN */
456# undef isPUNCT_L1
457# endif
458
459# if { VERSION < 5.13.7 } /* khw didn't investigate why this failed */
460# undef isALNUMC_L1
461#endif
462
d7412c0a 463# if { VERSION < 5.20.0 } /* earlier perls didn't include \v */
9dc2cc38
KW
464# undef isSPACE
465# undef isSPACE_A
876aded1 466# undef isSPACE_L1
e17f6823 467
9dc2cc38
KW
468# endif
469
b2049988
MHM
470__UNDEFINED__ isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
471__UNDEFINED__ isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
876aded1
KW
472__UNDEFINED__ isCNTRL_L1(c) (isCNTRL(c) || ( (WIDEST_UTYPE) (c) <= 0x9F \
473 && (WIDEST_UTYPE) (c) >= 0x80))
9dc2cc38
KW
474__UNDEFINED__ isLOWER(c) ((c) >= 'a' && (c) <= 'z')
475__UNDEFINED__ isUPPER(c) ((c) <= 'Z' && (c) >= 'A')
e17f6823 476
9dc2cc38
KW
477#endif /* Below are definitions common to EBCDIC and ASCII */
478
876aded1 479__UNDEFINED__ isASCII_L1(c) isASCII(c)
9dc2cc38
KW
480__UNDEFINED__ isALNUM(c) isWORDCHAR(c)
481__UNDEFINED__ isALNUMC(c) isALPHANUMERIC(c)
876aded1 482__UNDEFINED__ isALNUMC_L1(c) isALPHANUMERIC_L1(c)
9dc2cc38 483__UNDEFINED__ isALPHA(c) (isUPPER(c) || isLOWER(c))
876aded1 484__UNDEFINED__ isALPHA_L1(c) (isUPPER_L1(c) || isLOWER_L1(c))
9dc2cc38 485__UNDEFINED__ isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c))
876aded1 486__UNDEFINED__ isALPHANUMERIC_L1(c) (isALPHA_L1(c) || isDIGIT(c))
9dc2cc38 487__UNDEFINED__ isBLANK(c) ((c) == ' ' || (c) == '\t')
876aded1
KW
488__UNDEFINED__ isBLANK_L1(c) ( isBLANK(c) \
489 || ( (WIDEST_UTYPE) (c) < 256 \
490 && NATIVE_TO_LATIN1((U8) c) == 0xA0))
9dc2cc38 491__UNDEFINED__ isDIGIT(c) ((c) <= '9' && (c) >= '0')
876aded1 492__UNDEFINED__ isDIGIT_L1(c) isDIGIT(c)
9dc2cc38 493__UNDEFINED__ isGRAPH(c) (isWORDCHAR(c) || isPUNCT(c))
876aded1 494__UNDEFINED__ isGRAPH_L1(c) (isPRINT_L1(c) && (c) != ' ')
9dc2cc38 495__UNDEFINED__ isIDCONT(c) isWORDCHAR(c)
876aded1 496__UNDEFINED__ isIDCONT_L1(c) isWORDCHAR_L1(c)
9dc2cc38 497__UNDEFINED__ isIDFIRST(c) (isALPHA(c) || (c) == '_')
876aded1
KW
498__UNDEFINED__ isIDFIRST_L1(c) (isALPHA_L1(c) || NATIVE_TO_LATIN1(c) == '_')
499__UNDEFINED__ isLOWER_L1(c) ( isLOWER(c) \
500 || ( (WIDEST_UTYPE) (c) < 256 \
501 && ( ( NATIVE_TO_LATIN1((U8) c) >= 0xDF \
502 && NATIVE_TO_LATIN1((U8) c) != 0xF7) \
503 || NATIVE_TO_LATIN1((U8) c) == 0xAA \
504 || NATIVE_TO_LATIN1((U8) c) == 0xBA \
505 || NATIVE_TO_LATIN1((U8) c) == 0xB5)))
9dc2cc38 506__UNDEFINED__ isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0')
876aded1 507__UNDEFINED__ isOCTAL_L1(c) isOCTAL(c)
9dc2cc38 508__UNDEFINED__ isPRINT(c) (isGRAPH(c) || (c) == ' ')
876aded1 509__UNDEFINED__ isPRINT_L1(c) ((WIDEST_UTYPE) (c) < 256 && ! isCNTRL_L1(c))
9dc2cc38 510__UNDEFINED__ isPSXSPC(c) isSPACE(c)
876aded1 511__UNDEFINED__ isPSXSPC_L1(c) isSPACE_L1(c)
e17f6823
KW
512__UNDEFINED__ isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \
513 || (c) == '#' || (c) == '$' || (c) == '%' \
514 || (c) == '&' || (c) == '\'' || (c) == '(' \
515 || (c) == ')' || (c) == '*' || (c) == '+' \
516 || (c) == ',' || (c) == '.' || (c) == '/' \
517 || (c) == ':' || (c) == ';' || (c) == '<' \
518 || (c) == '=' || (c) == '>' || (c) == '?' \
519 || (c) == '@' || (c) == '[' || (c) == '\\' \
520 || (c) == ']' || (c) == '^' || (c) == '_' \
521 || (c) == '`' || (c) == '{' || (c) == '|' \
9dc2cc38 522 || (c) == '}' || (c) == '~')
876aded1
KW
523__UNDEFINED__ isPUNCT_L1(c) ( isPUNCT(c) \
524 || ( (WIDEST_UTYPE) (c) < 256 \
525 && ( NATIVE_TO_LATIN1((U8) c) == 0xA1 \
526 || NATIVE_TO_LATIN1((U8) c) == 0xA7 \
527 || NATIVE_TO_LATIN1((U8) c) == 0xAB \
528 || NATIVE_TO_LATIN1((U8) c) == 0xB6 \
529 || NATIVE_TO_LATIN1((U8) c) == 0xB7 \
530 || NATIVE_TO_LATIN1((U8) c) == 0xBB \
531 || NATIVE_TO_LATIN1((U8) c) == 0xBF)))
e17f6823 532__UNDEFINED__ isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \
9dc2cc38 533 || (c) == '\v' || (c) == '\f')
876aded1
KW
534__UNDEFINED__ isSPACE_L1(c) ( isSPACE(c) \
535 || ( (WIDEST_UTYPE) (c) < 256 \
536 && ( NATIVE_TO_LATIN1((U8) c) == 0x85 \
537 || NATIVE_TO_LATIN1((U8) c) == 0xA0)))
538__UNDEFINED__ isUPPER_L1(c) ( isUPPER(c) \
539 || ( (WIDEST_UTYPE) (c) < 256 \
540 && ( NATIVE_TO_LATIN1((U8) c) >= 0xC0 \
541 && NATIVE_TO_LATIN1((U8) c) <= 0xDE \
542 && NATIVE_TO_LATIN1((U8) c) != 0xD7)))
9dc2cc38 543__UNDEFINED__ isWORDCHAR(c) (isALPHANUMERIC(c) || (c) == '_')
876aded1 544__UNDEFINED__ isWORDCHAR_L1(c) (isIDFIRST_L1(c) || isDIGIT(c))
e17f6823
KW
545__UNDEFINED__ isXDIGIT(c) ( isDIGIT(c) \
546 || ((c) >= 'a' && (c) <= 'f') \
9dc2cc38 547 || ((c) >= 'A' && (c) <= 'F'))
876aded1 548__UNDEFINED__ isXDIGIT_L1(c) isXDIGIT(c)
9dc2cc38 549
ef89c4f1
KW
550__UNDEFINED__ isALNUM_A(c) isALNUM(c)
551__UNDEFINED__ isALNUMC_A(c) isALNUMC(c)
552__UNDEFINED__ isALPHA_A(c) isALPHA(c)
553__UNDEFINED__ isALPHANUMERIC_A(c) isALPHANUMERIC(c)
554__UNDEFINED__ isASCII_A(c) isASCII(c)
555__UNDEFINED__ isBLANK_A(c) isBLANK(c)
556__UNDEFINED__ isCNTRL_A(c) isCNTRL(c)
557__UNDEFINED__ isDIGIT_A(c) isDIGIT(c)
558__UNDEFINED__ isGRAPH_A(c) isGRAPH(c)
559__UNDEFINED__ isIDCONT_A(c) isIDCONT(c)
560__UNDEFINED__ isIDFIRST_A(c) isIDFIRST(c)
561__UNDEFINED__ isLOWER_A(c) isLOWER(c)
562__UNDEFINED__ isOCTAL_A(c) isOCTAL(c)
563__UNDEFINED__ isPRINT_A(c) isPRINT(c)
564__UNDEFINED__ isPSXSPC_A(c) isPSXSPC(c)
565__UNDEFINED__ isPUNCT_A(c) isPUNCT(c)
566__UNDEFINED__ isSPACE_A(c) isSPACE(c)
567__UNDEFINED__ isUPPER_A(c) isUPPER(c)
568__UNDEFINED__ isWORDCHAR_A(c) isWORDCHAR(c)
569__UNDEFINED__ isXDIGIT_A(c) isXDIGIT(c)
db42c902 570
ea4b7f32
JH
571/* Until we figure out how to support this in older perls... */
572#if { VERSION >= 5.8.0 }
573
574__UNDEFINED__ HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
575 SvUTF8(HeKEY_sv(he)) : \
576 (U32)HeKUTF8(he))
577
578#endif
579
94e22bd6
MH
580__UNDEFINED__ C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
581__UNDEFINED__ C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
582
72ec356a
KW
583__UNDEFINED__ LIKELY(x) (x)
584__UNDEFINED__ UNLIKELY(x) (x)
585
58329f0d
S
586#ifndef MUTABLE_PTR
587#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
588# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
589#else
590# define MUTABLE_PTR(p) ((void *) (p))
591#endif
592#endif
593
594__UNDEFINED__ MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
595
9132e1a3
MHM
596=xsmisc
597
8565c31a
MHM
598typedef XSPROTO(XSPROTO_test_t);
599typedef XSPROTO_test_t *XSPROTO_test_t_ptr;
600
9132e1a3
MHM
601XS(XS_Devel__PPPort_dXSTARG); /* prototype */
602XS(XS_Devel__PPPort_dXSTARG)
603{
604 dXSARGS;
605 dXSTARG;
2dd69576 606 IV iv;
e7368224
MH
607
608 PERL_UNUSED_VAR(cv);
9132e1a3 609 SP -= items;
2dd69576 610 iv = SvIV(ST(0)) + 1;
9132e1a3
MHM
611 PUSHi(iv);
612 XSRETURN(1);
613}
614
0d0f8426
MHM
615XS(XS_Devel__PPPort_dAXMARK); /* prototype */
616XS(XS_Devel__PPPort_dAXMARK)
617{
618 dSP;
619 dAXMARK;
620 dITEMS;
621 IV iv;
e7368224
MH
622
623 PERL_UNUSED_VAR(cv);
0d0f8426
MHM
624 SP -= items;
625 iv = SvIV(ST(0)) - 1;
c1a049cb 626 mPUSHi(iv);
0d0f8426
MHM
627 XSRETURN(1);
628}
629
9132e1a3
MHM
630=xsboot
631
8565c31a
MHM
632{
633 XSPROTO_test_t_ptr p = &XS_Devel__PPPort_dXSTARG;
634 newXS("Devel::PPPort::dXSTARG", *p, file);
635}
0d0f8426 636newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
9132e1a3 637
adfe19db
MHM
638=xsubs
639
640int
94e22bd6
MH
641OpSIBLING_tests()
642 PREINIT:
643 OP *x;
644 OP *kid;
65d1a6da 645 OP *middlekid;
94e22bd6
MH
646 OP *lastkid;
647 int count = 0;
648 int failures = 0;
649 int i;
650 CODE:
651 x = newOP(OP_PUSHMARK, 0);
652
653 /* No siblings yet! */
654 if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
655 failures++; warn("Op should not have had a sib");
656 }
657
658
659 /* Add 2 siblings */
660 kid = x;
661
662 for (i = 0; i < 2; i++) {
663 OP *newsib = newOP(OP_PUSHMARK, 0);
664 OpMORESIB_set(kid, newsib);
665
666 kid = OpSIBLING(kid);
667 lastkid = kid;
668 }
65d1a6da 669 middlekid = OpSIBLING(x);
94e22bd6
MH
670
671 /* Should now have a sibling */
672 if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
673 failures++; warn("Op should have had a sib after moresib_set");
674 }
675
676 /* Count the siblings */
677 for (kid = OpSIBLING(x); kid; kid = OpSIBLING(kid)) {
678 count++;
679 }
680
681 if (count != 2) {
682 failures++; warn("Kid had %d sibs, expected 2", count);
683 }
684
685 if (OpHAS_SIBLING(lastkid) || OpSIBLING(lastkid)) {
686 failures++; warn("Last kid should not have a sib");
687 }
688
689 /* Really sets the parent, and says 'no more siblings' */
690 OpLASTSIB_set(x, lastkid);
691
692 if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
693 failures++; warn("OpLASTSIB_set failed?");
694 }
695
696 /* Restore the kid */
697 OpMORESIB_set(x, lastkid);
698
699 /* Try to remove it again */
700 OpLASTSIB_set(x, NULL);
701
702 if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
703 failures++; warn("OpLASTSIB_set with NULL failed?");
704 }
705
706 /* Try to restore with maybesib_set */
707 OpMAYBESIB_set(x, lastkid, NULL);
708
709 if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
710 failures++; warn("Op should have had a sib after maybesibset");
711 }
712
65d1a6da
DM
713 op_free(lastkid);
714 op_free(middlekid);
715 op_free(x);
94e22bd6
MH
716 RETVAL = failures;
717 OUTPUT:
718 RETVAL
719
720int
721SvRXOK(sv)
722 SV *sv
723 CODE:
724 RETVAL = SvRXOK(sv);
725 OUTPUT:
726 RETVAL
727
728int
7bb03b24 729ptrtests()
b2049988
MHM
730 PREINIT:
731 int var, *p = &var;
7bb03b24 732
b2049988
MHM
733 CODE:
734 RETVAL = 0;
735 RETVAL += PTR2nat(p) != 0 ? 1 : 0;
736 RETVAL += PTR2ul(p) != 0UL ? 2 : 0;
737 RETVAL += PTR2UV(p) != (UV) 0 ? 4 : 0;
738 RETVAL += PTR2IV(p) != (IV) 0 ? 8 : 0;
739 RETVAL += PTR2NV(p) != (NV) 0 ? 16 : 0;
740 RETVAL += p > NUM2PTR(int *, 0) ? 32 : 0;
7bb03b24 741
b2049988
MHM
742 OUTPUT:
743 RETVAL
7bb03b24
MHM
744
745int
adfe19db 746gv_stashpvn(name, create)
b2049988
MHM
747 char *name
748 I32 create
749 CODE:
750 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
751 OUTPUT:
752 RETVAL
adfe19db
MHM
753
754int
755get_sv(name, create)
b2049988
MHM
756 char *name
757 I32 create
758 CODE:
759 RETVAL = get_sv(name, create) != NULL;
760 OUTPUT:
761 RETVAL
adfe19db
MHM
762
763int
764get_av(name, create)
b2049988
MHM
765 char *name
766 I32 create
767 CODE:
768 RETVAL = get_av(name, create) != NULL;
769 OUTPUT:
770 RETVAL
adfe19db
MHM
771
772int
773get_hv(name, create)
b2049988
MHM
774 char *name
775 I32 create
776 CODE:
777 RETVAL = get_hv(name, create) != NULL;
778 OUTPUT:
779 RETVAL
adfe19db
MHM
780
781int
782get_cv(name, create)
b2049988
MHM
783 char *name
784 I32 create
785 CODE:
786 RETVAL = get_cv(name, create) != NULL;
787 OUTPUT:
788 RETVAL
adfe19db
MHM
789
790void
0d0f8426 791xsreturn(two)
b2049988
MHM
792 int two
793 PPCODE:
794 mXPUSHp("test1", 5);
795 if (two)
796 mXPUSHp("test2", 5);
797 if (two)
798 XSRETURN(2);
799 else
800 XSRETURN(1);
0d0f8426 801
adfe19db
MHM
802SV*
803boolSV(value)
b2049988
MHM
804 int value
805 CODE:
806 RETVAL = newSVsv(boolSV(value));
807 OUTPUT:
808 RETVAL
adfe19db
MHM
809
810SV*
811DEFSV()
b2049988
MHM
812 CODE:
813 RETVAL = newSVsv(DEFSV);
814 OUTPUT:
815 RETVAL
adfe19db 816
51d6c659
MHM
817void
818DEFSV_modify()
b2049988
MHM
819 PPCODE:
820 XPUSHs(sv_mortalcopy(DEFSV));
821 ENTER;
822 SAVE_DEFSV;
823 DEFSV_set(newSVpvs("DEFSV"));
824 XPUSHs(sv_mortalcopy(DEFSV));
825 /* Yes, this leaks the above scalar; 5.005 with threads for some reason */
826 /* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */
827 /* sv_2mortal(DEFSV); */
828 LEAVE;
829 XPUSHs(sv_mortalcopy(DEFSV));
830 XSRETURN(3);
51d6c659 831
adfe19db
MHM
832int
833ERRSV()
b2049988 834 CODE:
f1305528 835 RETVAL = SvTRUEx(ERRSV);
b2049988
MHM
836 OUTPUT:
837 RETVAL
adfe19db
MHM
838
839SV*
840UNDERBAR()
b2049988
MHM
841 CODE:
842 {
843 dUNDERBAR;
844 RETVAL = newSVsv(UNDERBAR);
845 }
846 OUTPUT:
847 RETVAL
adfe19db 848
0d0f8426
MHM
849void
850prepush()
b2049988
MHM
851 CODE:
852 {
853 dXSTARG;
854 XSprePUSH;
855 PUSHi(42);
856 XSRETURN(1);
857 }
0d0f8426 858
f2ab5a41
MHM
859int
860PERL_ABS(a)
b2049988 861 int a
f2ab5a41
MHM
862
863void
864SVf(x)
b2049988
MHM
865 SV *x
866 PPCODE:
f2ab5a41 867#if { VERSION >= 5.004 }
71d5fd3c 868 x = sv_2mortal(newSVpvf("[%" SVf "]", SVfARG(x)));
f2ab5a41 869#endif
b2049988
MHM
870 XPUSHs(x);
871 XSRETURN(1);
f2ab5a41 872
fd7af155
MHM
873void
874Perl_ppaddr_t(string)
b2049988
MHM
875 char *string
876 PREINIT:
877 Perl_ppaddr_t lower;
878 PPCODE:
879 lower = PL_ppaddr[OP_LC];
880 mXPUSHs(newSVpv(string, 0));
881 PUTBACK;
882 ENTER;
883 (void)*(lower)(aTHXR);
884 SPAGAIN;
885 LEAVE;
886 XSRETURN(1);
fd7af155 887
ea4b7f32
JH
888#if { VERSION >= 5.8.0 }
889
890void
891check_HeUTF8(utf8_key)
892 SV *utf8_key;
893 PREINIT:
894 HV *hash;
895 HE *ent;
896 STRLEN klen;
897 char *key;
898 PPCODE:
899 hash = newHV();
900
901 key = SvPV(utf8_key, klen);
902 if (SvUTF8(utf8_key)) klen *= -1;
903 hv_store(hash, key, klen, newSVpvs("string"), 0);
904 hv_iterinit(hash);
905 ent = hv_iternext(hash);
94e22bd6
MH
906 assert(ent);
907 mXPUSHp((HeUTF8(ent) == 0 ? "norm" : "utf8"), 4);
ea4b7f32
JH
908 hv_undef(hash);
909
910
911#endif
912
94e22bd6
MH
913void
914check_c_array()
915 PREINIT:
916 int x[] = { 10, 11, 12, 13 };
917 PPCODE:
918 mXPUSHi(C_ARRAY_LENGTH(x)); /* 4 */
919 mXPUSHi(*(C_ARRAY_END(x)-1)); /* 13 */
920
9dc2cc38 921bool
db834d60 922isBLANK(ord)
9aa6a863 923 UV ord
9dc2cc38
KW
924 CODE:
925 RETVAL = isBLANK(ord);
926 OUTPUT:
927 RETVAL
928
929bool
db834d60 930isBLANK_A(ord)
9aa6a863 931 UV ord
9dc2cc38
KW
932 CODE:
933 RETVAL = isBLANK_A(ord);
934 OUTPUT:
935 RETVAL
936
937bool
876aded1
KW
938isBLANK_L1(ord)
939 UV ord
940 CODE:
941 RETVAL = isBLANK_L1(ord);
942 OUTPUT:
943 RETVAL
944
945bool
db834d60 946isUPPER(ord)
9aa6a863 947 UV ord
9dc2cc38
KW
948 CODE:
949 RETVAL = isUPPER(ord);
950 OUTPUT:
951 RETVAL
952
953bool
db834d60 954isUPPER_A(ord)
9aa6a863 955 UV ord
9dc2cc38
KW
956 CODE:
957 RETVAL = isUPPER_A(ord);
958 OUTPUT:
959 RETVAL
960
961bool
876aded1
KW
962isUPPER_L1(ord)
963 UV ord
964 CODE:
965 RETVAL = isUPPER_L1(ord);
966 OUTPUT:
967 RETVAL
968
969bool
db834d60 970isLOWER(ord)
9aa6a863 971 UV ord
9dc2cc38
KW
972 CODE:
973 RETVAL = isLOWER(ord);
974 OUTPUT:
975 RETVAL
976
977bool
db834d60 978isLOWER_A(ord)
9aa6a863 979 UV ord
9dc2cc38
KW
980 CODE:
981 RETVAL = isLOWER_A(ord);
982 OUTPUT:
983 RETVAL
984
985bool
876aded1
KW
986isLOWER_L1(ord)
987 UV ord
988 CODE:
989 RETVAL = isLOWER_L1(ord);
990 OUTPUT:
991 RETVAL
992
993bool
db834d60 994isALPHA(ord)
9aa6a863 995 UV ord
9dc2cc38
KW
996 CODE:
997 RETVAL = isALPHA(ord);
998 OUTPUT:
999 RETVAL
1000
1001bool
db834d60 1002isALPHA_A(ord)
9aa6a863 1003 UV ord
9dc2cc38
KW
1004 CODE:
1005 RETVAL = isALPHA_A(ord);
1006 OUTPUT:
1007 RETVAL
1008
1009bool
876aded1
KW
1010isALPHA_L1(ord)
1011 UV ord
1012 CODE:
1013 RETVAL = isALPHA_L1(ord);
1014 OUTPUT:
1015 RETVAL
1016
1017bool
db834d60 1018isWORDCHAR(ord)
9aa6a863 1019 UV ord
9dc2cc38
KW
1020 CODE:
1021 RETVAL = isWORDCHAR(ord);
1022 OUTPUT:
1023 RETVAL
1024
1025bool
db834d60 1026isWORDCHAR_A(ord)
9aa6a863 1027 UV ord
9dc2cc38
KW
1028 CODE:
1029 RETVAL = isWORDCHAR_A(ord);
1030 OUTPUT:
1031 RETVAL
1032
1033bool
876aded1
KW
1034isWORDCHAR_L1(ord)
1035 UV ord
1036 CODE:
1037 RETVAL = isWORDCHAR_L1(ord);
1038 OUTPUT:
1039 RETVAL
1040
1041bool
db834d60 1042isALPHANUMERIC(ord)
9aa6a863 1043 UV ord
9dc2cc38
KW
1044 CODE:
1045 RETVAL = isALPHANUMERIC(ord);
1046 OUTPUT:
1047 RETVAL
1048
1049bool
db834d60 1050isALPHANUMERIC_A(ord)
9aa6a863 1051 UV ord
9dc2cc38
KW
1052 CODE:
1053 RETVAL = isALPHANUMERIC_A(ord);
1054 OUTPUT:
1055 RETVAL
1056
1057bool
db834d60 1058isALNUM(ord)
9aa6a863 1059 UV ord
9dc2cc38
KW
1060 CODE:
1061 RETVAL = isALNUM(ord);
1062 OUTPUT:
1063 RETVAL
1064
1065bool
db834d60 1066isALNUM_A(ord)
9aa6a863 1067 UV ord
9dc2cc38
KW
1068 CODE:
1069 RETVAL = isALNUM_A(ord);
1070 OUTPUT:
1071 RETVAL
1072
1073bool
db834d60 1074isDIGIT(ord)
9aa6a863 1075 UV ord
9dc2cc38
KW
1076 CODE:
1077 RETVAL = isDIGIT(ord);
1078 OUTPUT:
1079 RETVAL
1080
1081bool
db834d60 1082isDIGIT_A(ord)
9aa6a863 1083 UV ord
9dc2cc38
KW
1084 CODE:
1085 RETVAL = isDIGIT_A(ord);
1086 OUTPUT:
1087 RETVAL
1088
1089bool
db834d60 1090isOCTAL(ord)
9aa6a863 1091 UV ord
9dc2cc38
KW
1092 CODE:
1093 RETVAL = isOCTAL(ord);
1094 OUTPUT:
1095 RETVAL
1096
1097bool
db834d60 1098isOCTAL_A(ord)
9aa6a863 1099 UV ord
9dc2cc38
KW
1100 CODE:
1101 RETVAL = isOCTAL_A(ord);
1102 OUTPUT:
1103 RETVAL
1104
1105bool
db834d60 1106isIDFIRST(ord)
9aa6a863 1107 UV ord
9dc2cc38
KW
1108 CODE:
1109 RETVAL = isIDFIRST(ord);
1110 OUTPUT:
1111 RETVAL
1112
1113bool
db834d60 1114isIDFIRST_A(ord)
9aa6a863 1115 UV ord
9dc2cc38
KW
1116 CODE:
1117 RETVAL = isIDFIRST_A(ord);
1118 OUTPUT:
1119 RETVAL
1120
1121bool
db834d60 1122isIDCONT(ord)
9aa6a863 1123 UV ord
9dc2cc38
KW
1124 CODE:
1125 RETVAL = isIDCONT(ord);
1126 OUTPUT:
1127 RETVAL
1128
1129bool
db834d60 1130isIDCONT_A(ord)
9aa6a863 1131 UV ord
9dc2cc38
KW
1132 CODE:
1133 RETVAL = isIDCONT_A(ord);
1134 OUTPUT:
1135 RETVAL
1136
1137bool
db834d60 1138isSPACE(ord)
9aa6a863 1139 UV ord
9dc2cc38
KW
1140 CODE:
1141 RETVAL = isSPACE(ord);
1142 OUTPUT:
1143 RETVAL
1144
1145bool
db834d60 1146isSPACE_A(ord)
9aa6a863 1147 UV ord
9dc2cc38
KW
1148 CODE:
1149 RETVAL = isSPACE_A(ord);
1150 OUTPUT:
1151 RETVAL
1152
1153bool
db834d60 1154isASCII(ord)
9aa6a863 1155 UV ord
9dc2cc38
KW
1156 CODE:
1157 RETVAL = isASCII(ord);
1158 OUTPUT:
1159 RETVAL
1160
1161bool
db834d60 1162isASCII_A(ord)
9aa6a863 1163 UV ord
9dc2cc38
KW
1164 CODE:
1165 RETVAL = isASCII_A(ord);
1166 OUTPUT:
1167 RETVAL
1168
1169bool
db834d60 1170isCNTRL(ord)
9aa6a863 1171 UV ord
9dc2cc38
KW
1172 CODE:
1173 RETVAL = isCNTRL(ord);
1174 OUTPUT:
1175 RETVAL
1176
1177bool
db834d60 1178isCNTRL_A(ord)
9aa6a863 1179 UV ord
9dc2cc38
KW
1180 CODE:
1181 RETVAL = isCNTRL_A(ord);
1182 OUTPUT:
1183 RETVAL
1184
1185bool
db834d60 1186isPRINT(ord)
9aa6a863 1187 UV ord
9dc2cc38
KW
1188 CODE:
1189 RETVAL = isPRINT(ord);
1190 OUTPUT:
1191 RETVAL
1192
1193bool
db834d60 1194isPRINT_A(ord)
9aa6a863 1195 UV ord
9dc2cc38
KW
1196 CODE:
1197 RETVAL = isPRINT_A(ord);
1198 OUTPUT:
1199 RETVAL
1200
1201bool
db834d60 1202isGRAPH(ord)
9aa6a863 1203 UV ord
9dc2cc38
KW
1204 CODE:
1205 RETVAL = isGRAPH(ord);
1206 OUTPUT:
1207 RETVAL
1208
1209bool
db834d60 1210isGRAPH_A(ord)
9aa6a863 1211 UV ord
9dc2cc38
KW
1212 CODE:
1213 RETVAL = isGRAPH_A(ord);
1214 OUTPUT:
1215 RETVAL
1216
1217bool
db834d60 1218isPUNCT(ord)
9aa6a863 1219 UV ord
9dc2cc38
KW
1220 CODE:
1221 RETVAL = isPUNCT(ord);
1222 OUTPUT:
1223 RETVAL
1224
1225bool
db834d60 1226isPUNCT_A(ord)
9aa6a863 1227 UV ord
9dc2cc38
KW
1228 CODE:
1229 RETVAL = isPUNCT_A(ord);
1230 OUTPUT:
1231 RETVAL
1232
1233bool
db834d60 1234isXDIGIT(ord)
9aa6a863 1235 UV ord
9dc2cc38
KW
1236 CODE:
1237 RETVAL = isXDIGIT(ord);
1238 OUTPUT:
1239 RETVAL
1240
1241bool
db834d60 1242isXDIGIT_A(ord)
9aa6a863 1243 UV ord
9dc2cc38
KW
1244 CODE:
1245 RETVAL = isXDIGIT_A(ord);
1246 OUTPUT:
1247 RETVAL
1248
1249bool
db834d60 1250isPSXSPC(ord)
9aa6a863 1251 UV ord
9dc2cc38
KW
1252 CODE:
1253 RETVAL = isPSXSPC(ord);
1254 OUTPUT:
1255 RETVAL
1256
1257bool
db834d60 1258isPSXSPC_A(ord)
9aa6a863 1259 UV ord
9dc2cc38
KW
1260 CODE:
1261 RETVAL = isPSXSPC_A(ord);
1262 OUTPUT:
1263 RETVAL
1264
876aded1
KW
1265bool
1266isALPHANUMERIC_L1(ord)
1267 UV ord
1268 CODE:
1269 RETVAL = isALPHANUMERIC_L1(ord);
1270 OUTPUT:
1271 RETVAL
1272
1273bool
1274isALNUMC_L1(ord)
1275 UV ord
1276 CODE:
1277 RETVAL = isALNUMC_L1(ord);
1278 OUTPUT:
1279 RETVAL
1280
1281bool
1282isDIGIT_L1(ord)
1283 UV ord
1284 CODE:
1285 RETVAL = isDIGIT_L1(ord);
1286 OUTPUT:
1287 RETVAL
1288
1289bool
1290isOCTAL_L1(ord)
1291 UV ord
1292 CODE:
1293 RETVAL = isOCTAL_L1(ord);
1294 OUTPUT:
1295 RETVAL
1296
1297bool
1298isIDFIRST_L1(ord)
1299 UV ord
1300 CODE:
1301 RETVAL = isIDFIRST_L1(ord);
1302 OUTPUT:
1303 RETVAL
1304
1305bool
1306isIDCONT_L1(ord)
1307 UV ord
1308 CODE:
1309 RETVAL = isIDCONT_L1(ord);
1310 OUTPUT:
1311 RETVAL
1312
1313bool
1314isSPACE_L1(ord)
1315 UV ord
1316 CODE:
1317 RETVAL = isSPACE_L1(ord);
1318 OUTPUT:
1319 RETVAL
1320
1321bool
1322isASCII_L1(ord)
1323 UV ord
1324 CODE:
1325 RETVAL = isASCII_L1(ord);
1326 OUTPUT:
1327 RETVAL
1328
1329bool
1330isCNTRL_L1(ord)
1331 UV ord
1332 CODE:
1333 RETVAL = isCNTRL_L1(ord);
1334 OUTPUT:
1335 RETVAL
1336
1337bool
1338isPRINT_L1(ord)
1339 UV ord
1340 CODE:
1341 RETVAL = isPRINT_L1(ord);
1342 OUTPUT:
1343 RETVAL
1344
1345bool
1346isGRAPH_L1(ord)
1347 UV ord
1348 CODE:
1349 RETVAL = isGRAPH_L1(ord);
1350 OUTPUT:
1351 RETVAL
1352
1353bool
1354isPUNCT_L1(ord)
1355 UV ord
1356 CODE:
1357 RETVAL = isPUNCT_L1(ord);
1358 OUTPUT:
1359 RETVAL
1360
1361bool
1362isXDIGIT_L1(ord)
1363 UV ord
1364 CODE:
1365 RETVAL = isXDIGIT_L1(ord);
1366 OUTPUT:
1367 RETVAL
1368
1369bool
1370isPSXSPC_L1(ord)
1371 UV ord
1372 CODE:
1373 RETVAL = isPSXSPC_L1(ord);
1374 OUTPUT:
1375 RETVAL
1376
1eff2a3b
KW
1377STRLEN
1378av_tindex(av)
9aa6a863 1379 SV *av
1eff2a3b 1380 CODE:
9aa6a863 1381 RETVAL = av_tindex((AV*)SvRV(av));
1eff2a3b
KW
1382 OUTPUT:
1383 RETVAL
1384
1385STRLEN
1386av_top_index(av)
9aa6a863 1387 SV *av
1eff2a3b 1388 CODE:
9aa6a863 1389 RETVAL = av_top_index((AV*)SvRV(av));
1eff2a3b
KW
1390 OUTPUT:
1391 RETVAL
1392
876aded1 1393=tests plan => 176
adfe19db
MHM
1394
1395use vars qw($my_sv @my_av %my_hv);
1396
adfe19db
MHM
1397ok(&Devel::PPPort::boolSV(1));
1398ok(!&Devel::PPPort::boolSV(0));
1399
1400$_ = "Fred";
1401ok(&Devel::PPPort::DEFSV(), "Fred");
1402ok(&Devel::PPPort::UNDERBAR(), "Fred");
1403
f551177d 1404if ("$]" >= 5.009002 && "$]" < 5.023 && "$]" < 5.023004) {
0d0f8426 1405 eval q{
b2049988 1406 no warnings "deprecated";
e5b2cbd0 1407 no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
0d0f8426
MHM
1408 my $_ = "Tony";
1409 ok(&Devel::PPPort::DEFSV(), "Fred");
1410 ok(&Devel::PPPort::UNDERBAR(), "Tony");
1411 };
1412}
1413else {
1414 ok(1);
1415 ok(1);
1416}
1417
51d6c659
MHM
1418my @r = &Devel::PPPort::DEFSV_modify();
1419
1420ok(@r == 3);
1421ok($r[0], 'Fred');
1422ok($r[1], 'DEFSV');
1423ok($r[2], 'Fred');
1424
1425ok(&Devel::PPPort::DEFSV(), "Fred");
1426
adfe19db
MHM
1427eval { 1 };
1428ok(!&Devel::PPPort::ERRSV());
1429eval { cannot_call_this_one() };
1430ok(&Devel::PPPort::ERRSV());
1431
1432ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
1433ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
1434ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
1435
1436$my_sv = 1;
1437ok(&Devel::PPPort::get_sv('my_sv', 0));
1438ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
1439ok(&Devel::PPPort::get_sv('not_my_sv', 1));
1440
1441@my_av = (1);
1442ok(&Devel::PPPort::get_av('my_av', 0));
1443ok(!&Devel::PPPort::get_av('not_my_av', 0));
1444ok(&Devel::PPPort::get_av('not_my_av', 1));
1445
1446%my_hv = (a=>1);
1447ok(&Devel::PPPort::get_hv('my_hv', 0));
1448ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
1449ok(&Devel::PPPort::get_hv('not_my_hv', 1));
1450
1451sub my_cv { 1 };
1452ok(&Devel::PPPort::get_cv('my_cv', 0));
1453ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
1454ok(&Devel::PPPort::get_cv('not_my_cv', 1));
1455
9132e1a3 1456ok(Devel::PPPort::dXSTARG(42), 43);
0d0f8426
MHM
1457ok(Devel::PPPort::dAXMARK(4711), 4710);
1458
1459ok(Devel::PPPort::prepush(), 42);
9132e1a3 1460
0d0f8426
MHM
1461ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
1462ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
f2ab5a41
MHM
1463
1464ok(Devel::PPPort::PERL_ABS(42), 42);
1465ok(Devel::PPPort::PERL_ABS(-13), 13);
1466
f551177d
S
1467ok(Devel::PPPort::SVf(42), "$]" >= 5.004 ? '[42]' : '42');
1468ok(Devel::PPPort::SVf('abc'), "$]" >= 5.004 ? '[abc]' : 'abc');
f2ab5a41 1469
fd7af155
MHM
1470ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
1471
7bb03b24 1472ok(&Devel::PPPort::ptrtests(), 63);
ea4b7f32 1473
94e22bd6
MH
1474ok(&Devel::PPPort::OpSIBLING_tests(), 0);
1475
f551177d 1476if ("$]" >= 5.009000) {
ea4b7f32
JH
1477 eval q{
1478 ok(&Devel::PPPort::check_HeUTF8("hello"), "norm");
1479 ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
1480 };
1481} else {
1482 ok(1, 1);
1483 ok(1, 1);
1484}
94e22bd6
MH
1485
1486@r = &Devel::PPPort::check_c_array();
1487ok($r[0], 4);
1488ok($r[1], "13");
1489
1490ok(!Devel::PPPort::SvRXOK(""));
1491ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
1492
f551177d 1493if ("$]" < 5.005) {
94e22bd6
MH
1494 skip 'no qr// objects in this perl', 0;
1495 skip 'no qr// objects in this perl', 0;
1496} else {
1497 my $qr = eval 'qr/./';
1498 ok(Devel::PPPort::SvRXOK($qr));
1499 ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise"));
1500}
9dc2cc38 1501
db834d60
KW
1502ok( Devel::PPPort::isBLANK(ord(" ")));
1503ok(! Devel::PPPort::isBLANK(ord("\n")));
9dc2cc38 1504
db834d60
KW
1505ok( Devel::PPPort::isBLANK_A(ord("\t")));
1506ok(! Devel::PPPort::isBLANK_A(ord("\r")));
9dc2cc38 1507
876aded1
KW
1508ok( Devel::PPPort::isBLANK_L1(ord("\t")));
1509ok(! Devel::PPPort::isBLANK_L1(ord("\r")));
1510
db834d60
KW
1511ok( Devel::PPPort::isUPPER(ord("A")));
1512ok(! Devel::PPPort::isUPPER(ord("a")));
9dc2cc38 1513
db834d60 1514ok( Devel::PPPort::isUPPER_A(ord("Z")));
9dc2cc38
KW
1515
1516# One of these two is uppercase in EBCDIC; the other in Latin1, but neither are
1517# ASCII uppercase.
ffafe9b2
KW
1518ok(! Devel::PPPort::isUPPER_A(0xDC));
1519ok(! Devel::PPPort::isUPPER_A(0xFC));
9dc2cc38 1520
876aded1
KW
1521ok(Devel::PPPort::isUPPER_L1(0xDC) || Devel::PPPort::isUPPER_L1(0xFC));
1522ok(! (Devel::PPPort::isUPPER_L1(0xDC) && Devel::PPPort::isUPPER_L1(0xFC)));
1523
db834d60
KW
1524ok( Devel::PPPort::isLOWER(ord("b")));
1525ok(! Devel::PPPort::isLOWER(ord("B")));
9dc2cc38 1526
db834d60 1527ok( Devel::PPPort::isLOWER_A(ord("y")));
9dc2cc38
KW
1528
1529# One of these two is lowercase in EBCDIC; the other in Latin1, but neither are
1530# ASCII lowercase.
ffafe9b2
KW
1531ok(! Devel::PPPort::isLOWER_A(0xDC));
1532ok(! Devel::PPPort::isLOWER_A(0xFC));
9dc2cc38 1533
876aded1
KW
1534ok(Devel::PPPort::isLOWER_L1(0xDC) || Devel::PPPort::isLOWER_L1(0xFC));
1535ok(! Devel::PPPort::isLOWER_L1(0xDC) && Devel::PPPort::isLOWER_L1(0xFC));
1536
db834d60
KW
1537ok( Devel::PPPort::isALPHA(ord("C")));
1538ok(! Devel::PPPort::isALPHA(ord("1")));
9dc2cc38 1539
db834d60
KW
1540ok( Devel::PPPort::isALPHA_A(ord("x")));
1541ok(! Devel::PPPort::isALPHA_A(0xDC));
9dc2cc38 1542
876aded1
KW
1543ok( Devel::PPPort::isALPHA_L1(ord("y")));
1544ok( Devel::PPPort::isALPHA_L1(0xDC));
1545ok(! Devel::PPPort::isALPHA_L1(0xB6));
1546
db834d60
KW
1547ok( Devel::PPPort::isWORDCHAR(ord("_")));
1548ok(! Devel::PPPort::isWORDCHAR(ord("@")));
9dc2cc38 1549
db834d60
KW
1550ok( Devel::PPPort::isWORDCHAR_A(ord("2")));
1551ok(! Devel::PPPort::isWORDCHAR_A(0xFC));
9dc2cc38 1552
876aded1
KW
1553ok( Devel::PPPort::isWORDCHAR_L1(ord("2")));
1554ok( Devel::PPPort::isWORDCHAR_L1(0xFC));
1555ok(! Devel::PPPort::isWORDCHAR_L1(0xB6));
1556
db834d60
KW
1557ok( Devel::PPPort::isALPHANUMERIC(ord("4")));
1558ok(! Devel::PPPort::isALPHANUMERIC(ord("_")));
9dc2cc38 1559
db834d60
KW
1560ok( Devel::PPPort::isALPHANUMERIC_A(ord("l")));
1561ok(! Devel::PPPort::isALPHANUMERIC_A(0xDC));
9dc2cc38 1562
876aded1
KW
1563ok( Devel::PPPort::isALPHANUMERIC_L1(ord("l")));
1564ok( Devel::PPPort::isALPHANUMERIC_L1(0xDC));
1565ok(! Devel::PPPort::isALPHANUMERIC_L1(0xB6));
1566
db834d60
KW
1567ok( Devel::PPPort::isALNUM(ord("c")));
1568ok(! Devel::PPPort::isALNUM(ord("}")));
9dc2cc38 1569
db834d60
KW
1570ok( Devel::PPPort::isALNUM_A(ord("5")));
1571ok(! Devel::PPPort::isALNUM_A(0xFC));
9dc2cc38 1572
876aded1
KW
1573ok( Devel::PPPort::isALNUMC_L1(ord("5")));
1574ok( Devel::PPPort::isALNUMC_L1(0xFC));
1575ok(! Devel::PPPort::isALNUMC_L1(0xB6));
1576
db834d60
KW
1577ok( Devel::PPPort::isDIGIT(ord("6")));
1578ok(! Devel::PPPort::isDIGIT(ord("_")));
9dc2cc38 1579
db834d60
KW
1580ok( Devel::PPPort::isDIGIT_A(ord("7")));
1581ok(! Devel::PPPort::isDIGIT_A(0xDC));
9dc2cc38 1582
876aded1
KW
1583ok( Devel::PPPort::isDIGIT_L1(ord("5")));
1584ok(! Devel::PPPort::isDIGIT_L1(0xDC));
1585
db834d60
KW
1586ok( Devel::PPPort::isOCTAL(ord("7")));
1587ok(! Devel::PPPort::isOCTAL(ord("8")));
9dc2cc38 1588
db834d60
KW
1589ok( Devel::PPPort::isOCTAL_A(ord("0")));
1590ok(! Devel::PPPort::isOCTAL_A(ord("9")));
9dc2cc38 1591
876aded1
KW
1592ok( Devel::PPPort::isOCTAL_L1(ord("2")));
1593ok(! Devel::PPPort::isOCTAL_L1(ord("8")));
1594
db834d60
KW
1595ok( Devel::PPPort::isIDFIRST(ord("D")));
1596ok(! Devel::PPPort::isIDFIRST(ord("1")));
9dc2cc38 1597
db834d60
KW
1598ok( Devel::PPPort::isIDFIRST_A(ord("_")));
1599ok(! Devel::PPPort::isIDFIRST_A(0xFC));
9dc2cc38 1600
876aded1
KW
1601ok( Devel::PPPort::isIDFIRST_L1(ord("_")));
1602ok( Devel::PPPort::isIDFIRST_L1(0xFC));
1603ok(! Devel::PPPort::isIDFIRST_L1(0xB6));
1604
db834d60
KW
1605ok( Devel::PPPort::isIDCONT(ord("e")));
1606ok(! Devel::PPPort::isIDCONT(ord("@")));
9dc2cc38 1607
db834d60
KW
1608ok( Devel::PPPort::isIDCONT_A(ord("2")));
1609ok(! Devel::PPPort::isIDCONT_A(0xDC));
9dc2cc38 1610
876aded1
KW
1611ok( Devel::PPPort::isIDCONT_L1(ord("4")));
1612ok( Devel::PPPort::isIDCONT_L1(0xDC));
1613ok(! Devel::PPPort::isIDCONT_L1(0xB6));
1614
db834d60
KW
1615ok( Devel::PPPort::isSPACE(ord(" ")));
1616ok(! Devel::PPPort::isSPACE(ord("_")));
9dc2cc38 1617
db834d60
KW
1618ok( Devel::PPPort::isSPACE_A(ord("\cK")));
1619ok(! Devel::PPPort::isSPACE_A(ord("F")));
9dc2cc38 1620
876aded1
KW
1621ok( Devel::PPPort::isSPACE_L1(ord("\cK")));
1622ok(! Devel::PPPort::isSPACE_L1(ord("g")));
1623
9dc2cc38
KW
1624# This stresses the edge for ASCII machines, but happens to work on EBCDIC as
1625# well
db834d60
KW
1626ok( Devel::PPPort::isASCII(0x7F));
1627ok(! Devel::PPPort::isASCII(0x80));
9dc2cc38 1628
db834d60 1629ok( Devel::PPPort::isASCII_A(ord("9")));
876aded1 1630ok( Devel::PPPort::isASCII_L1(ord("9")));
9dc2cc38
KW
1631
1632# B6 is the PARAGRAPH SIGN in ASCII and EBCDIC
db834d60 1633ok(! Devel::PPPort::isASCII_A(0xB6));
876aded1 1634ok(! Devel::PPPort::isASCII_L1(0xB6));
9dc2cc38 1635
db834d60
KW
1636ok( Devel::PPPort::isCNTRL(ord("\e")));
1637ok(! Devel::PPPort::isCNTRL(ord(" ")));
9dc2cc38 1638
db834d60
KW
1639ok( Devel::PPPort::isCNTRL_A(ord("\a")));
1640ok(! Devel::PPPort::isCNTRL_A(0xB6));
9dc2cc38 1641
876aded1
KW
1642ok( Devel::PPPort::isCNTRL_L1(ord("\a")));
1643ok( Devel::PPPort::isCNTRL_L1(ord(" ") - 1));
1644ok(! Devel::PPPort::isCNTRL_L1(0xB6));
1645if (ord('A') == 65) {
1646 ok(Devel::PPPort::isCNTRL_L1(0x80));
1647}
1648elsif (ord('^') == 106) {
1649 ok(Devel::PPPort::isCNTRL_L1(0x5F));
1650}
1651else {
1652 ok(Devel::PPPort::isCNTRL_L1(0xFF));
1653}
1654
db834d60
KW
1655ok( Devel::PPPort::isPRINT(ord(" ")));
1656ok(! Devel::PPPort::isPRINT(ord("\n")));
9dc2cc38 1657
db834d60
KW
1658ok( Devel::PPPort::isPRINT_A(ord("G")));
1659ok(! Devel::PPPort::isPRINT_A(0xB6));
9dc2cc38 1660
876aded1
KW
1661ok( Devel::PPPort::isPRINT_L1(ord("~")));
1662ok( Devel::PPPort::isPRINT_L1(0xB6));
1663ok(! Devel::PPPort::isPRINT_L1(ord("\r")));
1664
db834d60
KW
1665ok( Devel::PPPort::isGRAPH(ord("h")));
1666ok(! Devel::PPPort::isGRAPH(ord(" ")));
9dc2cc38 1667
db834d60
KW
1668ok( Devel::PPPort::isGRAPH_A(ord("i")));
1669ok(! Devel::PPPort::isGRAPH_A(0xB6));
9dc2cc38 1670
876aded1
KW
1671ok( Devel::PPPort::isGRAPH_L1(ord("j")));
1672ok( Devel::PPPort::isGRAPH_L1(0xB6));
1673ok(! Devel::PPPort::isGRAPH_L1(4));
1674
db834d60
KW
1675ok( Devel::PPPort::isPUNCT(ord("#")));
1676ok(! Devel::PPPort::isPUNCT(ord(" ")));
9dc2cc38 1677
db834d60
KW
1678ok( Devel::PPPort::isPUNCT_A(ord("*")));
1679ok(! Devel::PPPort::isPUNCT_A(0xB6));
9dc2cc38 1680
876aded1
KW
1681ok( Devel::PPPort::isPUNCT_L1(ord("+")));
1682ok( Devel::PPPort::isPUNCT_L1(0xB6));
1683
db834d60
KW
1684ok( Devel::PPPort::isXDIGIT(ord("A")));
1685ok(! Devel::PPPort::isXDIGIT(ord("_")));
9dc2cc38 1686
db834d60
KW
1687ok( Devel::PPPort::isXDIGIT_A(ord("9")));
1688ok(! Devel::PPPort::isXDIGIT_A(0xDC));
9dc2cc38 1689
876aded1
KW
1690ok( Devel::PPPort::isXDIGIT_L1(ord("9")));
1691ok(! Devel::PPPort::isXDIGIT_L1(0xFF));
1692
db834d60
KW
1693ok( Devel::PPPort::isPSXSPC(ord(" ")));
1694ok(! Devel::PPPort::isPSXSPC(ord("k")));
9dc2cc38 1695
db834d60
KW
1696ok( Devel::PPPort::isPSXSPC_A(ord("\cK")));
1697ok(! Devel::PPPort::isPSXSPC_A(0xFC));
1eff2a3b 1698
876aded1
KW
1699ok( Devel::PPPort::isPSXSPC_L1(ord("\cK")));
1700ok(! Devel::PPPort::isPSXSPC_L1(0xFC));
1701
1eff2a3b
KW
1702ok(&Devel::PPPort::av_top_index([1,2,3]), 2);
1703ok(&Devel::PPPort::av_tindex([1,2,3,4]), 3);