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