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
1 ################################################################################
2 ##
3 ##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
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__
15 C_ARRAY_END
16 C_ARRAY_LENGTH
17 cBOOL
18 END_EXTERN_C
19 EXTERN_C
20 HeUTF8
21 INT2PTR
22 MUTABLE_PTR
23 MUTABLE_SV
24 NUM2PTR
25 NVTYPE
26 OpHAS_SIBLING
27 OpLASTSIB_set
28 OpMAYBESIB_set
29 OpMORESIB_set
30 OpSIBLING
31 PERL_GCC_BRACE_GROUPS_FORBIDDEN
32 PERL_HASH
33 PERLIO_FUNCS_CAST
34 PERLIO_FUNCS_DECL
35 PERL_UNUSED_ARG
36 PERL_UNUSED_CONTEXT
37 PERL_UNUSED_DECL
38 PERL_UNUSED_RESULT
39 PERL_UNUSED_VAR
40 PERL_USE_GCC_BRACE_GROUPS
41 PTR2IV
42 PTR2NV
43 PTR2ul
44 PTR2UV
45 PTRV
46 START_EXTERN_C
47 STMT_END
48 STMT_START
49 SvRX
50 SvRXOK
51 UTF8_MAXBYTES
52 WIDEST_UTYPE
53 XSRETURN
54
55 =implementation
56
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))
63 __UNDEFINED__ HEf_SVKEY   -2
64
65 #ifndef SvRX
66 #if { NEED SvRX }
67
68 void *
69 SvRX(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
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
94 #  else
95 #    define PERL_UNUSED_DECL
96 #  endif
97 #endif
98
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
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
128 __UNDEFINED__  NOOP          /*EMPTY*/(void)0
129 __UNDEFINED__  dNOOP         extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
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
137 typedef NVTYPE NV;
138 #endif
139
140 #ifndef INT2PTR
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
152 #endif
153
154 #ifndef PTR2ul
155 #  if PTRSIZE == LONGSIZE
156 #    define PTR2ul(p)     (unsigned long)(p)
157 #  else
158 #    define PTR2ul(p)     INT2PTR(unsigned long,p)
159 #  endif
160 #endif
161
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)
167
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
181 #if defined(PERL_GCC_PEDANTIC)
182 #  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
183 #    define PERL_GCC_BRACE_GROUPS_FORBIDDEN
184 #  endif
185 #endif
186
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
193 #undef STMT_START
194 #undef STMT_END
195 #ifdef PERL_USE_GCC_BRACE_GROUPS
196 #  define STMT_START    (void)( /* gcc supports ``({ STATEMENTS; })'' */
197 #  define STMT_END      )
198 #else
199 #  if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
200 #    define STMT_START  if (1)
201 #    define STMT_END    else (void)0
202 #  else
203 #    define STMT_START  do
204 #    define STMT_END    while (0)
205 #  endif
206 #endif
207
208 __UNDEFINED__  boolSV(b)    ((b) ? &PL_sv_yes : &PL_sv_no)
209
210 /* DEFSV appears first in 5.004_56 */
211 __UNDEFINED__  DEFSV        GvSV(PL_defgv)
212 __UNDEFINED__  SAVE_DEFSV   SAVESPTR(GvSV(PL_defgv))
213 __UNDEFINED__  DEFSV_set(sv) (DEFSV = (sv))
214
215 /* Older perls (<=5.003) lack AvFILLp */
216 __UNDEFINED__  AvFILLp      AvFILL
217
218 __UNDEFINED__  ERRSV        get_sv("@",FALSE)
219
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
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
242 __UNDEFINED__  dXSTARG         SV * targ = sv_newmortal()
243
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
259 __UNDEFINED__  XSPROTO(name)   void name(pTHX_ CV* cv)
260 __UNDEFINED__  SVfARG(p)       ((void*)(p))
261
262 __UNDEFINED__  PERL_ABS(x)     ((x) < 0 ? -(x) : (x))
263
264 __UNDEFINED__  dVAR            dNOOP
265
266 __UNDEFINED__  SVf             "_"
267
268 __UNDEFINED__  UTF8_MAXBYTES   UTF8_MAXLEN
269
270 __UNDEFINED__  CPERLscope(x)   x
271
272 __UNDEFINED__  PERL_HASH(hash,str,len) \
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; \
280     } STMT_END
281
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
292 /* provide these typedefs for older perls */
293 #if { VERSION < 5.9.3 }
294
295 # ifdef ARGSproto
296 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
297 # else
298 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
299 # endif
300
301 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
302
303 #endif
304
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
312 # else
313 #  define WIDEST_UTYPE U32
314 # endif
315 #endif
316
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
451 __UNDEFINED__ isASCII(c)        ((WIDEST_UTYPE) (c) <= 127)
452 __UNDEFINED__ isCNTRL(c)        ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
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
507
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
517 __UNDEFINED__ C_ARRAY_LENGTH(a)         (sizeof(a)/sizeof((a)[0]))
518 __UNDEFINED__ C_ARRAY_END(a)            ((a) + C_ARRAY_LENGTH(a))
519
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
530 =xsmisc
531
532 typedef XSPROTO(XSPROTO_test_t);
533 typedef XSPROTO_test_t *XSPROTO_test_t_ptr;
534
535 XS(XS_Devel__PPPort_dXSTARG);  /* prototype */
536 XS(XS_Devel__PPPort_dXSTARG)
537 {
538   dXSARGS;
539   dXSTARG;
540   IV iv;
541
542   PERL_UNUSED_VAR(cv);
543   SP -= items;
544   iv = SvIV(ST(0)) + 1;
545   PUSHi(iv);
546   XSRETURN(1);
547 }
548
549 XS(XS_Devel__PPPort_dAXMARK);  /* prototype */
550 XS(XS_Devel__PPPort_dAXMARK)
551 {
552   dSP;
553   dAXMARK;
554   dITEMS;
555   IV iv;
556
557   PERL_UNUSED_VAR(cv);
558   SP -= items;
559   iv = SvIV(ST(0)) - 1;
560   mPUSHi(iv);
561   XSRETURN(1);
562 }
563
564 =xsinit
565
566 #define NEED_SvRX
567
568 =xsboot
569
570 {
571   XSPROTO_test_t_ptr p = &XS_Devel__PPPort_dXSTARG;
572   newXS("Devel::PPPort::dXSTARG", *p, file);
573 }
574 newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
575
576 =xsubs
577
578 int
579 OpSIBLING_tests()
580         PREINIT:
581                 OP *x;
582                 OP *kid;
583                 OP *middlekid;
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                 }
607                 middlekid = OpSIBLING(x);
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
651                 op_free(lastkid);
652                 op_free(middlekid);
653                 op_free(x);
654                 RETVAL = failures;
655         OUTPUT:
656                 RETVAL
657
658 int
659 SvRXOK(sv)
660         SV *sv
661         CODE:
662                 RETVAL = SvRXOK(sv);
663         OUTPUT:
664                 RETVAL
665
666 int
667 ptrtests()
668         PREINIT:
669                 int var, *p = &var;
670
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;
679
680         OUTPUT:
681                 RETVAL
682
683 int
684 gv_stashpvn(name, create)
685         char *name
686         I32 create
687         CODE:
688                 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
689         OUTPUT:
690                 RETVAL
691
692 int
693 get_sv(name, create)
694         char *name
695         I32 create
696         CODE:
697                 RETVAL = get_sv(name, create) != NULL;
698         OUTPUT:
699                 RETVAL
700
701 int
702 get_av(name, create)
703         char *name
704         I32 create
705         CODE:
706                 RETVAL = get_av(name, create) != NULL;
707         OUTPUT:
708                 RETVAL
709
710 int
711 get_hv(name, create)
712         char *name
713         I32 create
714         CODE:
715                 RETVAL = get_hv(name, create) != NULL;
716         OUTPUT:
717                 RETVAL
718
719 int
720 get_cv(name, create)
721         char *name
722         I32 create
723         CODE:
724                 RETVAL = get_cv(name, create) != NULL;
725         OUTPUT:
726                 RETVAL
727
728 void
729 xsreturn(two)
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);
739
740 SV*
741 boolSV(value)
742         int value
743         CODE:
744                 RETVAL = newSVsv(boolSV(value));
745         OUTPUT:
746                 RETVAL
747
748 SV*
749 DEFSV()
750         CODE:
751                 RETVAL = newSVsv(DEFSV);
752         OUTPUT:
753                 RETVAL
754
755 void
756 DEFSV_modify()
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);
769
770 int
771 ERRSV()
772         CODE:
773                 RETVAL = SvTRUE(ERRSV);
774         OUTPUT:
775                 RETVAL
776
777 SV*
778 UNDERBAR()
779         CODE:
780                 {
781                   dUNDERBAR;
782                   RETVAL = newSVsv(UNDERBAR);
783                 }
784         OUTPUT:
785                 RETVAL
786
787 void
788 prepush()
789         CODE:
790                 {
791                   dXSTARG;
792                   XSprePUSH;
793                   PUSHi(42);
794                   XSRETURN(1);
795                 }
796
797 int
798 PERL_ABS(a)
799         int a
800
801 void
802 SVf(x)
803         SV *x
804         PPCODE:
805 #if { VERSION >= 5.004 }
806                 x = sv_2mortal(newSVpvf("[%" SVf "]", SVfARG(x)));
807 #endif
808                 XPUSHs(x);
809                 XSRETURN(1);
810
811 void
812 Perl_ppaddr_t(string)
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);
825
826 #if { VERSION >= 5.8.0 }
827
828 void
829 check_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);
844                 assert(ent);
845                 mXPUSHp((HeUTF8(ent) == 0 ? "norm" : "utf8"), 4);
846                 hv_undef(hash);
847
848
849 #endif
850
851 void
852 check_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
859 bool
860 test_isBLANK(UV ord)
861     CODE:
862         RETVAL = isBLANK(ord);
863     OUTPUT:
864         RETVAL
865
866 bool
867 test_isBLANK_A(UV ord)
868     CODE:
869         RETVAL = isBLANK_A(ord);
870     OUTPUT:
871         RETVAL
872
873 bool
874 test_isUPPER(UV ord)
875     CODE:
876         RETVAL = isUPPER(ord);
877     OUTPUT:
878         RETVAL
879
880 bool
881 test_isUPPER_A(UV ord)
882     CODE:
883         RETVAL = isUPPER_A(ord);
884     OUTPUT:
885         RETVAL
886
887 bool
888 test_isLOWER(UV ord)
889     CODE:
890         RETVAL = isLOWER(ord);
891     OUTPUT:
892         RETVAL
893
894 bool
895 test_isLOWER_A(UV ord)
896     CODE:
897         RETVAL = isLOWER_A(ord);
898     OUTPUT:
899         RETVAL
900
901 bool
902 test_isALPHA(UV ord)
903     CODE:
904         RETVAL = isALPHA(ord);
905     OUTPUT:
906         RETVAL
907
908 bool
909 test_isALPHA_A(UV ord)
910     CODE:
911         RETVAL = isALPHA_A(ord);
912     OUTPUT:
913         RETVAL
914
915 bool
916 test_isWORDCHAR(UV ord)
917     CODE:
918         RETVAL = isWORDCHAR(ord);
919     OUTPUT:
920         RETVAL
921
922 bool
923 test_isWORDCHAR_A(UV ord)
924     CODE:
925         RETVAL = isWORDCHAR_A(ord);
926     OUTPUT:
927         RETVAL
928
929 bool
930 test_isALPHANUMERIC(UV ord)
931     CODE:
932         RETVAL = isALPHANUMERIC(ord);
933     OUTPUT:
934         RETVAL
935
936 bool
937 test_isALPHANUMERIC_A(UV ord)
938     CODE:
939         RETVAL = isALPHANUMERIC_A(ord);
940     OUTPUT:
941         RETVAL
942
943 bool
944 test_isALNUM(UV ord)
945     CODE:
946         RETVAL = isALNUM(ord);
947     OUTPUT:
948         RETVAL
949
950 bool
951 test_isALNUM_A(UV ord)
952     CODE:
953         RETVAL = isALNUM_A(ord);
954     OUTPUT:
955         RETVAL
956
957 bool
958 test_isDIGIT(UV ord)
959     CODE:
960         RETVAL = isDIGIT(ord);
961     OUTPUT:
962         RETVAL
963
964 bool
965 test_isDIGIT_A(UV ord)
966     CODE:
967         RETVAL = isDIGIT_A(ord);
968     OUTPUT:
969         RETVAL
970
971 bool
972 test_isOCTAL(UV ord)
973     CODE:
974         RETVAL = isOCTAL(ord);
975     OUTPUT:
976         RETVAL
977
978 bool
979 test_isOCTAL_A(UV ord)
980     CODE:
981         RETVAL = isOCTAL_A(ord);
982     OUTPUT:
983         RETVAL
984
985 bool
986 test_isIDFIRST(UV ord)
987     CODE:
988         RETVAL = isIDFIRST(ord);
989     OUTPUT:
990         RETVAL
991
992 bool
993 test_isIDFIRST_A(UV ord)
994     CODE:
995         RETVAL = isIDFIRST_A(ord);
996     OUTPUT:
997         RETVAL
998
999 bool
1000 test_isIDCONT(UV ord)
1001     CODE:
1002         RETVAL = isIDCONT(ord);
1003     OUTPUT:
1004         RETVAL
1005
1006 bool
1007 test_isIDCONT_A(UV ord)
1008     CODE:
1009         RETVAL = isIDCONT_A(ord);
1010     OUTPUT:
1011         RETVAL
1012
1013 bool
1014 test_isSPACE(UV ord)
1015     CODE:
1016         RETVAL = isSPACE(ord);
1017     OUTPUT:
1018         RETVAL
1019
1020 bool
1021 test_isSPACE_A(UV ord)
1022     CODE:
1023         RETVAL = isSPACE_A(ord);
1024     OUTPUT:
1025         RETVAL
1026
1027 bool
1028 test_isASCII(UV ord)
1029     CODE:
1030         RETVAL = isASCII(ord);
1031     OUTPUT:
1032         RETVAL
1033
1034 bool
1035 test_isASCII_A(UV ord)
1036     CODE:
1037         RETVAL = isASCII_A(ord);
1038     OUTPUT:
1039         RETVAL
1040
1041 bool
1042 test_isCNTRL(UV ord)
1043     CODE:
1044         RETVAL = isCNTRL(ord);
1045     OUTPUT:
1046         RETVAL
1047
1048 bool
1049 test_isCNTRL_A(UV ord)
1050     CODE:
1051         RETVAL = isCNTRL_A(ord);
1052     OUTPUT:
1053         RETVAL
1054
1055 bool
1056 test_isPRINT(UV ord)
1057     CODE:
1058         RETVAL = isPRINT(ord);
1059     OUTPUT:
1060         RETVAL
1061
1062 bool
1063 test_isPRINT_A(UV ord)
1064     CODE:
1065         RETVAL = isPRINT_A(ord);
1066     OUTPUT:
1067         RETVAL
1068
1069 bool
1070 test_isGRAPH(UV ord)
1071     CODE:
1072         RETVAL = isGRAPH(ord);
1073     OUTPUT:
1074         RETVAL
1075
1076 bool
1077 test_isGRAPH_A(UV ord)
1078     CODE:
1079         RETVAL = isGRAPH_A(ord);
1080     OUTPUT:
1081         RETVAL
1082
1083 bool
1084 test_isPUNCT(UV ord)
1085     CODE:
1086         RETVAL = isPUNCT(ord);
1087     OUTPUT:
1088         RETVAL
1089
1090 bool
1091 test_isPUNCT_A(UV ord)
1092     CODE:
1093         RETVAL = isPUNCT_A(ord);
1094     OUTPUT:
1095         RETVAL
1096
1097 bool
1098 test_isXDIGIT(UV ord)
1099     CODE:
1100         RETVAL = isXDIGIT(ord);
1101     OUTPUT:
1102         RETVAL
1103
1104 bool
1105 test_isXDIGIT_A(UV ord)
1106     CODE:
1107         RETVAL = isXDIGIT_A(ord);
1108     OUTPUT:
1109         RETVAL
1110
1111 bool
1112 test_isPSXSPC(UV ord)
1113     CODE:
1114         RETVAL = isPSXSPC(ord);
1115     OUTPUT:
1116         RETVAL
1117
1118 bool
1119 test_isPSXSPC_A(UV ord)
1120     CODE:
1121         RETVAL = isPSXSPC_A(ord);
1122     OUTPUT:
1123         RETVAL
1124
1125 =tests plan => 126
1126
1127 use vars qw($my_sv @my_av %my_hv);
1128
1129 ok(&Devel::PPPort::boolSV(1));
1130 ok(!&Devel::PPPort::boolSV(0));
1131
1132 $_ = "Fred";
1133 ok(&Devel::PPPort::DEFSV(), "Fred");
1134 ok(&Devel::PPPort::UNDERBAR(), "Fred");
1135
1136 if ("$]" >= 5.009002 && "$]" < 5.023 && "$]" < 5.023004) {
1137   eval q{
1138     no warnings "deprecated";
1139     no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
1140     my $_ = "Tony";
1141     ok(&Devel::PPPort::DEFSV(), "Fred");
1142     ok(&Devel::PPPort::UNDERBAR(), "Tony");
1143   };
1144 }
1145 else {
1146   ok(1);
1147   ok(1);
1148 }
1149
1150 my @r = &Devel::PPPort::DEFSV_modify();
1151
1152 ok(@r == 3);
1153 ok($r[0], 'Fred');
1154 ok($r[1], 'DEFSV');
1155 ok($r[2], 'Fred');
1156
1157 ok(&Devel::PPPort::DEFSV(), "Fred");
1158
1159 eval { 1 };
1160 ok(!&Devel::PPPort::ERRSV());
1161 eval { cannot_call_this_one() };
1162 ok(&Devel::PPPort::ERRSV());
1163
1164 ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
1165 ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
1166 ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
1167
1168 $my_sv = 1;
1169 ok(&Devel::PPPort::get_sv('my_sv', 0));
1170 ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
1171 ok(&Devel::PPPort::get_sv('not_my_sv', 1));
1172
1173 @my_av = (1);
1174 ok(&Devel::PPPort::get_av('my_av', 0));
1175 ok(!&Devel::PPPort::get_av('not_my_av', 0));
1176 ok(&Devel::PPPort::get_av('not_my_av', 1));
1177
1178 %my_hv = (a=>1);
1179 ok(&Devel::PPPort::get_hv('my_hv', 0));
1180 ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
1181 ok(&Devel::PPPort::get_hv('not_my_hv', 1));
1182
1183 sub my_cv { 1 };
1184 ok(&Devel::PPPort::get_cv('my_cv', 0));
1185 ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
1186 ok(&Devel::PPPort::get_cv('not_my_cv', 1));
1187
1188 ok(Devel::PPPort::dXSTARG(42), 43);
1189 ok(Devel::PPPort::dAXMARK(4711), 4710);
1190
1191 ok(Devel::PPPort::prepush(), 42);
1192
1193 ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
1194 ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
1195
1196 ok(Devel::PPPort::PERL_ABS(42), 42);
1197 ok(Devel::PPPort::PERL_ABS(-13), 13);
1198
1199 ok(Devel::PPPort::SVf(42), "$]" >= 5.004 ? '[42]' : '42');
1200 ok(Devel::PPPort::SVf('abc'), "$]" >= 5.004 ? '[abc]' : 'abc');
1201
1202 ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
1203
1204 ok(&Devel::PPPort::ptrtests(), 63);
1205
1206 ok(&Devel::PPPort::OpSIBLING_tests(), 0);
1207
1208 if ("$]" >= 5.009000) {
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 }
1217
1218 @r = &Devel::PPPort::check_c_array();
1219 ok($r[0], 4);
1220 ok($r[1], "13");
1221
1222 ok(!Devel::PPPort::SvRXOK(""));
1223 ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
1224
1225 if ("$]" < 5.005) {
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 }
1233
1234 ok(  Devel::PPPort::test_isBLANK(ord(" ")));
1235 ok(! Devel::PPPort::test_isBLANK(ord("\n")));
1236
1237 ok(  Devel::PPPort::test_isBLANK_A(ord("\t")));
1238 ok(! Devel::PPPort::test_isBLANK_A(ord("\r")));
1239
1240 ok(  Devel::PPPort::test_isUPPER(ord("A")));
1241 ok(! Devel::PPPort::test_isUPPER(ord("a")));
1242
1243 ok(  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.
1247 ok(! Devel::PPPort::test_isUPPER_A(ord(0xDC)));
1248 ok(! Devel::PPPort::test_isUPPER_A(ord(0xFC)));
1249
1250 ok(  Devel::PPPort::test_isLOWER(ord("b")));
1251 ok(! Devel::PPPort::test_isLOWER(ord("B")));
1252
1253 ok(  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.
1257 ok(! Devel::PPPort::test_isLOWER_A(ord(0xDC)));
1258 ok(! Devel::PPPort::test_isLOWER_A(ord(0xFC)));
1259
1260 ok(  Devel::PPPort::test_isALPHA(ord("C")));
1261 ok(! Devel::PPPort::test_isALPHA(ord("1")));
1262
1263 ok(  Devel::PPPort::test_isALPHA_A(ord("x")));
1264 ok(! Devel::PPPort::test_isALPHA_A(0xDC));
1265
1266 ok(  Devel::PPPort::test_isWORDCHAR(ord("_")));
1267 ok(! Devel::PPPort::test_isWORDCHAR(ord("@")));
1268
1269 ok(  Devel::PPPort::test_isWORDCHAR_A(ord("2")));
1270 ok(! Devel::PPPort::test_isWORDCHAR_A(0xFC));
1271
1272 ok(  Devel::PPPort::test_isALPHANUMERIC(ord("4")));
1273 ok(! Devel::PPPort::test_isALPHANUMERIC(ord("_")));
1274
1275 ok(  Devel::PPPort::test_isALPHANUMERIC_A(ord("l")));
1276 ok(! Devel::PPPort::test_isALPHANUMERIC_A(0xDC));
1277
1278 ok(  Devel::PPPort::test_isALNUM(ord("c")));
1279 ok(! Devel::PPPort::test_isALNUM(ord("}")));
1280
1281 ok(  Devel::PPPort::test_isALNUM_A(ord("5")));
1282 ok(! Devel::PPPort::test_isALNUM_A(0xFC));
1283
1284 ok(  Devel::PPPort::test_isDIGIT(ord("6")));
1285 ok(! Devel::PPPort::test_isDIGIT(ord("_")));
1286
1287 ok(  Devel::PPPort::test_isDIGIT_A(ord("7")));
1288 ok(! Devel::PPPort::test_isDIGIT_A(0xDC));
1289
1290 ok(  Devel::PPPort::test_isOCTAL(ord("7")));
1291 ok(! Devel::PPPort::test_isOCTAL(ord("8")));
1292
1293 ok(  Devel::PPPort::test_isOCTAL_A(ord("0")));
1294 ok(! Devel::PPPort::test_isOCTAL_A(ord("9")));
1295
1296 ok(  Devel::PPPort::test_isIDFIRST(ord("D")));
1297 ok(! Devel::PPPort::test_isIDFIRST(ord("1")));
1298
1299 ok(  Devel::PPPort::test_isIDFIRST_A(ord("_")));
1300 ok(! Devel::PPPort::test_isIDFIRST_A(0xFC));
1301
1302 ok(  Devel::PPPort::test_isIDCONT(ord("e")));
1303 ok(! Devel::PPPort::test_isIDCONT(ord("@")));
1304
1305 ok(  Devel::PPPort::test_isIDCONT_A(ord("2")));
1306 ok(! Devel::PPPort::test_isIDCONT_A(0xDC));
1307
1308 ok(  Devel::PPPort::test_isSPACE(ord(" ")));
1309 ok(! Devel::PPPort::test_isSPACE(ord("_")));
1310
1311 ok(  Devel::PPPort::test_isSPACE_A(ord("\cK")));
1312 ok(! 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
1316 ok(  Devel::PPPort::test_isASCII(0x7F));
1317 ok(! Devel::PPPort::test_isASCII(0x80));
1318
1319 ok(  Devel::PPPort::test_isASCII_A(ord("9")));
1320
1321 # B6 is the PARAGRAPH SIGN in ASCII and EBCDIC
1322 ok(! Devel::PPPort::test_isASCII_A(0xB6));
1323
1324 ok(  Devel::PPPort::test_isCNTRL(ord("\e")));
1325 ok(! Devel::PPPort::test_isCNTRL(ord(" ")));
1326
1327 ok(  Devel::PPPort::test_isCNTRL_A(ord("\a")));
1328 ok(! Devel::PPPort::test_isCNTRL_A(0xB6));
1329
1330 ok(  Devel::PPPort::test_isPRINT(ord(" ")));
1331 ok(! Devel::PPPort::test_isPRINT(ord("\n")));
1332
1333 ok(  Devel::PPPort::test_isPRINT_A(ord("G")));
1334 ok(! Devel::PPPort::test_isPRINT_A(0xB6));
1335
1336 ok(  Devel::PPPort::test_isGRAPH(ord("h")));
1337 ok(! Devel::PPPort::test_isGRAPH(ord(" ")));
1338
1339 ok(  Devel::PPPort::test_isGRAPH_A(ord("i")));
1340 ok(! Devel::PPPort::test_isGRAPH_A(0xB6));
1341
1342 ok(  Devel::PPPort::test_isPUNCT(ord("#")));
1343 ok(! Devel::PPPort::test_isPUNCT(ord(" ")));
1344
1345 ok(  Devel::PPPort::test_isPUNCT_A(ord("*")));
1346 ok(! Devel::PPPort::test_isPUNCT_A(0xB6));
1347
1348 ok(  Devel::PPPort::test_isXDIGIT(ord("A")));
1349 ok(! Devel::PPPort::test_isXDIGIT(ord("_")));
1350
1351 ok(  Devel::PPPort::test_isXDIGIT_A(ord("9")));
1352 ok(! Devel::PPPort::test_isXDIGIT_A(0xDC));
1353
1354 ok(  Devel::PPPort::test_isPSXSPC(ord(" ")));
1355 ok(! Devel::PPPort::test_isPSXSPC(ord("k")));
1356
1357 ok(  Devel::PPPort::test_isPSXSPC_A(ord("\cK")));
1358 ok(! Devel::PPPort::test_isPSXSPC_A(0xFC));