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