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
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 END_EXTERN_C
16 EXTERN_C
17 INT2PTR
18 MUTABLE_PTR
19 NVTYPE
20 PERL_GCC_BRACE_GROUPS_FORBIDDEN
21 PERLIO_FUNCS_CAST
22 PERLIO_FUNCS_DECL
23 PERL_UNUSED_ARG
24 PERL_UNUSED_CONTEXT
25 PERL_UNUSED_DECL
26 PERL_UNUSED_RESULT
27 PERL_UNUSED_VAR
28 PERL_USE_GCC_BRACE_GROUPS
29 PTR2ul
30 PTRV
31 START_EXTERN_C
32 STMT_END
33 STMT_START
34 SvRX
35 WIDEST_UTYPE
36 XSRETURN
37
38 =implementation
39
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))
46 __UNDEFINED__ HEf_SVKEY   -2
47
48 #if defined(DEBUGGING) && !defined(__COVERITY__)
49 __UNDEFINED__ __ASSERT_(statement)  assert(statement),
50 #else
51 __UNDEFINED__ __ASSERT_(statement)
52 #endif
53
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)
55 __UNDEFINED__ SvRXOK(sv) (!!SvRX(sv))
56
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
64 #  else
65 #    define PERL_UNUSED_DECL
66 #  endif
67 #endif
68
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
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
98 __UNDEFINED__  NOOP          /*EMPTY*/(void)0
99 __UNDEFINED__  dNOOP         extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
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
107 typedef NVTYPE NV;
108 #endif
109
110 #ifndef INT2PTR
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
122 #endif
123
124 #ifndef PTR2ul
125 #  if PTRSIZE == LONGSIZE
126 #    define PTR2ul(p)     (unsigned long)(p)
127 #  else
128 #    define PTR2ul(p)     INT2PTR(unsigned long,p)
129 #  endif
130 #endif
131
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)
137
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
151 #if { VERSION < 5.004 } || defined(PERL_GCC_PEDANTIC)
152 #  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
153 #    define PERL_GCC_BRACE_GROUPS_FORBIDDEN
154 #  endif
155 #endif
156
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
163 #undef STMT_START
164 #undef STMT_END
165 #ifdef PERL_USE_GCC_BRACE_GROUPS
166 #  define STMT_START    (void)( /* gcc supports ``({ STATEMENTS; })'' */
167 #  define STMT_END      )
168 #else
169 #  if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
170 #    define STMT_START  if (1)
171 #    define STMT_END    else (void)0
172 #  else
173 #    define STMT_START  do
174 #    define STMT_END    while (0)
175 #  endif
176 #endif
177
178 __UNDEFINED__  boolSV(b)    ((b) ? &PL_sv_yes : &PL_sv_no)
179
180 /* DEFSV appears first in 5.004_56 */
181 __UNDEFINED__  DEFSV        GvSV(PL_defgv)
182 __UNDEFINED__  SAVE_DEFSV   SAVESPTR(GvSV(PL_defgv))
183 __UNDEFINED__  DEFSV_set(sv) (DEFSV = (sv))
184
185 /* Older perls (<=5.003) lack AvFILLp */
186 __UNDEFINED__  AvFILLp      AvFILL
187
188 __UNDEFINED__  av_tindex    AvFILL
189 __UNDEFINED__  av_top_index AvFILL
190
191 __UNDEFINED__  ERRSV        get_sv("@",FALSE)
192
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
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
215 __UNDEFINED__  dXSTARG         SV * targ = sv_newmortal()
216
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
232 __UNDEFINED__  XSPROTO(name)   void name(pTHX_ CV* cv)
233 __UNDEFINED__  SVfARG(p)       ((void*)(p))
234
235 __UNDEFINED__  PERL_ABS(x)     ((x) < 0 ? -(x) : (x))
236
237 __UNDEFINED__  dVAR            dNOOP
238
239 __UNDEFINED__  SVf             "_"
240
241 __UNDEFINED__  CPERLscope(x)   x
242
243 __UNDEFINED__  PERL_HASH(hash,str,len) \
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; \
251     } STMT_END
252
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
263 /* provide these typedefs for older perls */
264 #if { VERSION < 5.9.3 }
265
266 # ifdef ARGSproto
267 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
268 # else
269 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
270 # endif
271
272 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
273
274 #endif
275
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
283 # else
284 #  define WIDEST_UTYPE U32
285 # endif
286 #endif
287
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
390 # if { VERSION < 5.8.0 } /* earlier perls omitted DEL */
391 #  undef isCNTRL
392 # endif
393
394 # if { VERSION < 5.10.0 }
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. */
398 #  undef isPRINT
399 #  undef isPRINT_A
400 # endif
401
402 # if { VERSION < 5.14.0 }
403 /* earlier perls always returned true if the parameter was a signed char */
404 #  undef isASCII
405 #  undef isASCII_A
406 # endif
407
408 # if { VERSION < 5.20.0 } /* earlier perls didn't include \v */
409 #  undef isSPACE
410 #  undef isSPACE_A
411 # endif
412
413 __UNDEFINED__ isASCII(c)        ((WIDEST_UTYPE) (c) <= 127)
414 __UNDEFINED__ isCNTRL(c)        ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
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
469
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
479 __UNDEFINED__ C_ARRAY_LENGTH(a)         (sizeof(a)/sizeof((a)[0]))
480 __UNDEFINED__ C_ARRAY_END(a)            ((a) + C_ARRAY_LENGTH(a))
481
482 __UNDEFINED__ LIKELY(x) (x)
483 __UNDEFINED__ UNLIKELY(x) (x)
484
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
495 =xsmisc
496
497 typedef XSPROTO(XSPROTO_test_t);
498 typedef XSPROTO_test_t *XSPROTO_test_t_ptr;
499
500 XS(XS_Devel__PPPort_dXSTARG);  /* prototype */
501 XS(XS_Devel__PPPort_dXSTARG)
502 {
503   dXSARGS;
504   dXSTARG;
505   IV iv;
506
507   PERL_UNUSED_VAR(cv);
508   SP -= items;
509   iv = SvIV(ST(0)) + 1;
510   PUSHi(iv);
511   XSRETURN(1);
512 }
513
514 XS(XS_Devel__PPPort_dAXMARK);  /* prototype */
515 XS(XS_Devel__PPPort_dAXMARK)
516 {
517   dSP;
518   dAXMARK;
519   dITEMS;
520   IV iv;
521
522   PERL_UNUSED_VAR(cv);
523   SP -= items;
524   iv = SvIV(ST(0)) - 1;
525   mPUSHi(iv);
526   XSRETURN(1);
527 }
528
529 =xsboot
530
531 {
532   XSPROTO_test_t_ptr p = &XS_Devel__PPPort_dXSTARG;
533   newXS("Devel::PPPort::dXSTARG", *p, file);
534 }
535 newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
536
537 =xsubs
538
539 int
540 OpSIBLING_tests()
541         PREINIT:
542                 OP *x;
543                 OP *kid;
544                 OP *middlekid;
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                 }
568                 middlekid = OpSIBLING(x);
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
612                 op_free(lastkid);
613                 op_free(middlekid);
614                 op_free(x);
615                 RETVAL = failures;
616         OUTPUT:
617                 RETVAL
618
619 int
620 SvRXOK(sv)
621         SV *sv
622         CODE:
623                 RETVAL = SvRXOK(sv);
624         OUTPUT:
625                 RETVAL
626
627 int
628 ptrtests()
629         PREINIT:
630                 int var, *p = &var;
631
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;
640
641         OUTPUT:
642                 RETVAL
643
644 int
645 gv_stashpvn(name, create)
646         char *name
647         I32 create
648         CODE:
649                 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
650         OUTPUT:
651                 RETVAL
652
653 int
654 get_sv(name, create)
655         char *name
656         I32 create
657         CODE:
658                 RETVAL = get_sv(name, create) != NULL;
659         OUTPUT:
660                 RETVAL
661
662 int
663 get_av(name, create)
664         char *name
665         I32 create
666         CODE:
667                 RETVAL = get_av(name, create) != NULL;
668         OUTPUT:
669                 RETVAL
670
671 int
672 get_hv(name, create)
673         char *name
674         I32 create
675         CODE:
676                 RETVAL = get_hv(name, create) != NULL;
677         OUTPUT:
678                 RETVAL
679
680 int
681 get_cv(name, create)
682         char *name
683         I32 create
684         CODE:
685                 RETVAL = get_cv(name, create) != NULL;
686         OUTPUT:
687                 RETVAL
688
689 void
690 xsreturn(two)
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);
700
701 SV*
702 boolSV(value)
703         int value
704         CODE:
705                 RETVAL = newSVsv(boolSV(value));
706         OUTPUT:
707                 RETVAL
708
709 SV*
710 DEFSV()
711         CODE:
712                 RETVAL = newSVsv(DEFSV);
713         OUTPUT:
714                 RETVAL
715
716 void
717 DEFSV_modify()
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);
730
731 int
732 ERRSV()
733         CODE:
734                 RETVAL = SvTRUEx(ERRSV);
735         OUTPUT:
736                 RETVAL
737
738 SV*
739 UNDERBAR()
740         CODE:
741                 {
742                   dUNDERBAR;
743                   RETVAL = newSVsv(UNDERBAR);
744                 }
745         OUTPUT:
746                 RETVAL
747
748 void
749 prepush()
750         CODE:
751                 {
752                   dXSTARG;
753                   XSprePUSH;
754                   PUSHi(42);
755                   XSRETURN(1);
756                 }
757
758 int
759 PERL_ABS(a)
760         int a
761
762 void
763 SVf(x)
764         SV *x
765         PPCODE:
766 #if { VERSION >= 5.004 }
767                 x = sv_2mortal(newSVpvf("[%" SVf "]", SVfARG(x)));
768 #endif
769                 XPUSHs(x);
770                 XSRETURN(1);
771
772 void
773 Perl_ppaddr_t(string)
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);
786
787 #if { VERSION >= 5.8.0 }
788
789 void
790 check_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);
805                 assert(ent);
806                 mXPUSHp((HeUTF8(ent) == 0 ? "norm" : "utf8"), 4);
807                 hv_undef(hash);
808
809
810 #endif
811
812 void
813 check_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
820 bool
821 isBLANK(ord)
822     UV ord
823     CODE:
824         RETVAL = isBLANK(ord);
825     OUTPUT:
826         RETVAL
827
828 bool
829 isBLANK_A(ord)
830     UV ord
831     CODE:
832         RETVAL = isBLANK_A(ord);
833     OUTPUT:
834         RETVAL
835
836 bool
837 isUPPER(ord)
838     UV ord
839     CODE:
840         RETVAL = isUPPER(ord);
841     OUTPUT:
842         RETVAL
843
844 bool
845 isUPPER_A(ord)
846     UV ord
847     CODE:
848         RETVAL = isUPPER_A(ord);
849     OUTPUT:
850         RETVAL
851
852 bool
853 isLOWER(ord)
854     UV ord
855     CODE:
856         RETVAL = isLOWER(ord);
857     OUTPUT:
858         RETVAL
859
860 bool
861 isLOWER_A(ord)
862     UV ord
863     CODE:
864         RETVAL = isLOWER_A(ord);
865     OUTPUT:
866         RETVAL
867
868 bool
869 isALPHA(ord)
870     UV ord
871     CODE:
872         RETVAL = isALPHA(ord);
873     OUTPUT:
874         RETVAL
875
876 bool
877 isALPHA_A(ord)
878     UV ord
879     CODE:
880         RETVAL = isALPHA_A(ord);
881     OUTPUT:
882         RETVAL
883
884 bool
885 isWORDCHAR(ord)
886     UV ord
887     CODE:
888         RETVAL = isWORDCHAR(ord);
889     OUTPUT:
890         RETVAL
891
892 bool
893 isWORDCHAR_A(ord)
894     UV ord
895     CODE:
896         RETVAL = isWORDCHAR_A(ord);
897     OUTPUT:
898         RETVAL
899
900 bool
901 isALPHANUMERIC(ord)
902     UV ord
903     CODE:
904         RETVAL = isALPHANUMERIC(ord);
905     OUTPUT:
906         RETVAL
907
908 bool
909 isALPHANUMERIC_A(ord)
910     UV ord
911     CODE:
912         RETVAL = isALPHANUMERIC_A(ord);
913     OUTPUT:
914         RETVAL
915
916 bool
917 isALNUM(ord)
918     UV ord
919     CODE:
920         RETVAL = isALNUM(ord);
921     OUTPUT:
922         RETVAL
923
924 bool
925 isALNUM_A(ord)
926     UV ord
927     CODE:
928         RETVAL = isALNUM_A(ord);
929     OUTPUT:
930         RETVAL
931
932 bool
933 isDIGIT(ord)
934     UV ord
935     CODE:
936         RETVAL = isDIGIT(ord);
937     OUTPUT:
938         RETVAL
939
940 bool
941 isDIGIT_A(ord)
942     UV ord
943     CODE:
944         RETVAL = isDIGIT_A(ord);
945     OUTPUT:
946         RETVAL
947
948 bool
949 isOCTAL(ord)
950     UV ord
951     CODE:
952         RETVAL = isOCTAL(ord);
953     OUTPUT:
954         RETVAL
955
956 bool
957 isOCTAL_A(ord)
958     UV ord
959     CODE:
960         RETVAL = isOCTAL_A(ord);
961     OUTPUT:
962         RETVAL
963
964 bool
965 isIDFIRST(ord)
966     UV ord
967     CODE:
968         RETVAL = isIDFIRST(ord);
969     OUTPUT:
970         RETVAL
971
972 bool
973 isIDFIRST_A(ord)
974     UV ord
975     CODE:
976         RETVAL = isIDFIRST_A(ord);
977     OUTPUT:
978         RETVAL
979
980 bool
981 isIDCONT(ord)
982     UV ord
983     CODE:
984         RETVAL = isIDCONT(ord);
985     OUTPUT:
986         RETVAL
987
988 bool
989 isIDCONT_A(ord)
990     UV ord
991     CODE:
992         RETVAL = isIDCONT_A(ord);
993     OUTPUT:
994         RETVAL
995
996 bool
997 isSPACE(ord)
998     UV ord
999     CODE:
1000         RETVAL = isSPACE(ord);
1001     OUTPUT:
1002         RETVAL
1003
1004 bool
1005 isSPACE_A(ord)
1006     UV ord
1007     CODE:
1008         RETVAL = isSPACE_A(ord);
1009     OUTPUT:
1010         RETVAL
1011
1012 bool
1013 isASCII(ord)
1014     UV ord
1015     CODE:
1016         RETVAL = isASCII(ord);
1017     OUTPUT:
1018         RETVAL
1019
1020 bool
1021 isASCII_A(ord)
1022     UV ord
1023     CODE:
1024         RETVAL = isASCII_A(ord);
1025     OUTPUT:
1026         RETVAL
1027
1028 bool
1029 isCNTRL(ord)
1030     UV ord
1031     CODE:
1032         RETVAL = isCNTRL(ord);
1033     OUTPUT:
1034         RETVAL
1035
1036 bool
1037 isCNTRL_A(ord)
1038     UV ord
1039     CODE:
1040         RETVAL = isCNTRL_A(ord);
1041     OUTPUT:
1042         RETVAL
1043
1044 bool
1045 isPRINT(ord)
1046     UV ord
1047     CODE:
1048         RETVAL = isPRINT(ord);
1049     OUTPUT:
1050         RETVAL
1051
1052 bool
1053 isPRINT_A(ord)
1054     UV ord
1055     CODE:
1056         RETVAL = isPRINT_A(ord);
1057     OUTPUT:
1058         RETVAL
1059
1060 bool
1061 isGRAPH(ord)
1062     UV ord
1063     CODE:
1064         RETVAL = isGRAPH(ord);
1065     OUTPUT:
1066         RETVAL
1067
1068 bool
1069 isGRAPH_A(ord)
1070     UV ord
1071     CODE:
1072         RETVAL = isGRAPH_A(ord);
1073     OUTPUT:
1074         RETVAL
1075
1076 bool
1077 isPUNCT(ord)
1078     UV ord
1079     CODE:
1080         RETVAL = isPUNCT(ord);
1081     OUTPUT:
1082         RETVAL
1083
1084 bool
1085 isPUNCT_A(ord)
1086     UV ord
1087     CODE:
1088         RETVAL = isPUNCT_A(ord);
1089     OUTPUT:
1090         RETVAL
1091
1092 bool
1093 isXDIGIT(ord)
1094     UV ord
1095     CODE:
1096         RETVAL = isXDIGIT(ord);
1097     OUTPUT:
1098         RETVAL
1099
1100 bool
1101 isXDIGIT_A(ord)
1102     UV ord
1103     CODE:
1104         RETVAL = isXDIGIT_A(ord);
1105     OUTPUT:
1106         RETVAL
1107
1108 bool
1109 isPSXSPC(ord)
1110     UV ord
1111     CODE:
1112         RETVAL = isPSXSPC(ord);
1113     OUTPUT:
1114         RETVAL
1115
1116 bool
1117 isPSXSPC_A(ord)
1118     UV ord
1119     CODE:
1120         RETVAL = isPSXSPC_A(ord);
1121     OUTPUT:
1122         RETVAL
1123
1124 STRLEN
1125 av_tindex(av)
1126         SV *av
1127         CODE:
1128                 RETVAL = av_tindex((AV*)SvRV(av));
1129         OUTPUT:
1130                 RETVAL
1131
1132 STRLEN
1133 av_top_index(av)
1134         SV *av
1135         CODE:
1136                 RETVAL = av_top_index((AV*)SvRV(av));
1137         OUTPUT:
1138                 RETVAL
1139
1140 =tests plan => 128
1141
1142 use vars qw($my_sv @my_av %my_hv);
1143
1144 ok(&Devel::PPPort::boolSV(1));
1145 ok(!&Devel::PPPort::boolSV(0));
1146
1147 $_ = "Fred";
1148 ok(&Devel::PPPort::DEFSV(), "Fred");
1149 ok(&Devel::PPPort::UNDERBAR(), "Fred");
1150
1151 if ("$]" >= 5.009002 && "$]" < 5.023 && "$]" < 5.023004) {
1152   eval q{
1153     no warnings "deprecated";
1154     no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
1155     my $_ = "Tony";
1156     ok(&Devel::PPPort::DEFSV(), "Fred");
1157     ok(&Devel::PPPort::UNDERBAR(), "Tony");
1158   };
1159 }
1160 else {
1161   ok(1);
1162   ok(1);
1163 }
1164
1165 my @r = &Devel::PPPort::DEFSV_modify();
1166
1167 ok(@r == 3);
1168 ok($r[0], 'Fred');
1169 ok($r[1], 'DEFSV');
1170 ok($r[2], 'Fred');
1171
1172 ok(&Devel::PPPort::DEFSV(), "Fred");
1173
1174 eval { 1 };
1175 ok(!&Devel::PPPort::ERRSV());
1176 eval { cannot_call_this_one() };
1177 ok(&Devel::PPPort::ERRSV());
1178
1179 ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
1180 ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
1181 ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
1182
1183 $my_sv = 1;
1184 ok(&Devel::PPPort::get_sv('my_sv', 0));
1185 ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
1186 ok(&Devel::PPPort::get_sv('not_my_sv', 1));
1187
1188 @my_av = (1);
1189 ok(&Devel::PPPort::get_av('my_av', 0));
1190 ok(!&Devel::PPPort::get_av('not_my_av', 0));
1191 ok(&Devel::PPPort::get_av('not_my_av', 1));
1192
1193 %my_hv = (a=>1);
1194 ok(&Devel::PPPort::get_hv('my_hv', 0));
1195 ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
1196 ok(&Devel::PPPort::get_hv('not_my_hv', 1));
1197
1198 sub my_cv { 1 };
1199 ok(&Devel::PPPort::get_cv('my_cv', 0));
1200 ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
1201 ok(&Devel::PPPort::get_cv('not_my_cv', 1));
1202
1203 ok(Devel::PPPort::dXSTARG(42), 43);
1204 ok(Devel::PPPort::dAXMARK(4711), 4710);
1205
1206 ok(Devel::PPPort::prepush(), 42);
1207
1208 ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
1209 ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
1210
1211 ok(Devel::PPPort::PERL_ABS(42), 42);
1212 ok(Devel::PPPort::PERL_ABS(-13), 13);
1213
1214 ok(Devel::PPPort::SVf(42), "$]" >= 5.004 ? '[42]' : '42');
1215 ok(Devel::PPPort::SVf('abc'), "$]" >= 5.004 ? '[abc]' : 'abc');
1216
1217 ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
1218
1219 ok(&Devel::PPPort::ptrtests(), 63);
1220
1221 ok(&Devel::PPPort::OpSIBLING_tests(), 0);
1222
1223 if ("$]" >= 5.009000) {
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 }
1232
1233 @r = &Devel::PPPort::check_c_array();
1234 ok($r[0], 4);
1235 ok($r[1], "13");
1236
1237 ok(!Devel::PPPort::SvRXOK(""));
1238 ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
1239
1240 if ("$]" < 5.005) {
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 }
1248
1249 ok(  Devel::PPPort::isBLANK(ord(" ")));
1250 ok(! Devel::PPPort::isBLANK(ord("\n")));
1251
1252 ok(  Devel::PPPort::isBLANK_A(ord("\t")));
1253 ok(! Devel::PPPort::isBLANK_A(ord("\r")));
1254
1255 ok(  Devel::PPPort::isUPPER(ord("A")));
1256 ok(! Devel::PPPort::isUPPER(ord("a")));
1257
1258 ok(  Devel::PPPort::isUPPER_A(ord("Z")));
1259
1260 # One of these two is uppercase in EBCDIC; the other in Latin1, but neither are
1261 # ASCII uppercase.
1262 ok(! Devel::PPPort::isUPPER_A(ord(0xDC)));
1263 ok(! Devel::PPPort::isUPPER_A(ord(0xFC)));
1264
1265 ok(  Devel::PPPort::isLOWER(ord("b")));
1266 ok(! Devel::PPPort::isLOWER(ord("B")));
1267
1268 ok(  Devel::PPPort::isLOWER_A(ord("y")));
1269
1270 # One of these two is lowercase in EBCDIC; the other in Latin1, but neither are
1271 # ASCII lowercase.
1272 ok(! Devel::PPPort::isLOWER_A(ord(0xDC)));
1273 ok(! Devel::PPPort::isLOWER_A(ord(0xFC)));
1274
1275 ok(  Devel::PPPort::isALPHA(ord("C")));
1276 ok(! Devel::PPPort::isALPHA(ord("1")));
1277
1278 ok(  Devel::PPPort::isALPHA_A(ord("x")));
1279 ok(! Devel::PPPort::isALPHA_A(0xDC));
1280
1281 ok(  Devel::PPPort::isWORDCHAR(ord("_")));
1282 ok(! Devel::PPPort::isWORDCHAR(ord("@")));
1283
1284 ok(  Devel::PPPort::isWORDCHAR_A(ord("2")));
1285 ok(! Devel::PPPort::isWORDCHAR_A(0xFC));
1286
1287 ok(  Devel::PPPort::isALPHANUMERIC(ord("4")));
1288 ok(! Devel::PPPort::isALPHANUMERIC(ord("_")));
1289
1290 ok(  Devel::PPPort::isALPHANUMERIC_A(ord("l")));
1291 ok(! Devel::PPPort::isALPHANUMERIC_A(0xDC));
1292
1293 ok(  Devel::PPPort::isALNUM(ord("c")));
1294 ok(! Devel::PPPort::isALNUM(ord("}")));
1295
1296 ok(  Devel::PPPort::isALNUM_A(ord("5")));
1297 ok(! Devel::PPPort::isALNUM_A(0xFC));
1298
1299 ok(  Devel::PPPort::isDIGIT(ord("6")));
1300 ok(! Devel::PPPort::isDIGIT(ord("_")));
1301
1302 ok(  Devel::PPPort::isDIGIT_A(ord("7")));
1303 ok(! Devel::PPPort::isDIGIT_A(0xDC));
1304
1305 ok(  Devel::PPPort::isOCTAL(ord("7")));
1306 ok(! Devel::PPPort::isOCTAL(ord("8")));
1307
1308 ok(  Devel::PPPort::isOCTAL_A(ord("0")));
1309 ok(! Devel::PPPort::isOCTAL_A(ord("9")));
1310
1311 ok(  Devel::PPPort::isIDFIRST(ord("D")));
1312 ok(! Devel::PPPort::isIDFIRST(ord("1")));
1313
1314 ok(  Devel::PPPort::isIDFIRST_A(ord("_")));
1315 ok(! Devel::PPPort::isIDFIRST_A(0xFC));
1316
1317 ok(  Devel::PPPort::isIDCONT(ord("e")));
1318 ok(! Devel::PPPort::isIDCONT(ord("@")));
1319
1320 ok(  Devel::PPPort::isIDCONT_A(ord("2")));
1321 ok(! Devel::PPPort::isIDCONT_A(0xDC));
1322
1323 ok(  Devel::PPPort::isSPACE(ord(" ")));
1324 ok(! Devel::PPPort::isSPACE(ord("_")));
1325
1326 ok(  Devel::PPPort::isSPACE_A(ord("\cK")));
1327 ok(! Devel::PPPort::isSPACE_A(ord("F")));
1328
1329 # This stresses the edge for ASCII machines, but happens to work on EBCDIC as
1330 # well
1331 ok(  Devel::PPPort::isASCII(0x7F));
1332 ok(! Devel::PPPort::isASCII(0x80));
1333
1334 ok(  Devel::PPPort::isASCII_A(ord("9")));
1335
1336 # B6 is the PARAGRAPH SIGN in ASCII and EBCDIC
1337 ok(! Devel::PPPort::isASCII_A(0xB6));
1338
1339 ok(  Devel::PPPort::isCNTRL(ord("\e")));
1340 ok(! Devel::PPPort::isCNTRL(ord(" ")));
1341
1342 ok(  Devel::PPPort::isCNTRL_A(ord("\a")));
1343 ok(! Devel::PPPort::isCNTRL_A(0xB6));
1344
1345 ok(  Devel::PPPort::isPRINT(ord(" ")));
1346 ok(! Devel::PPPort::isPRINT(ord("\n")));
1347
1348 ok(  Devel::PPPort::isPRINT_A(ord("G")));
1349 ok(! Devel::PPPort::isPRINT_A(0xB6));
1350
1351 ok(  Devel::PPPort::isGRAPH(ord("h")));
1352 ok(! Devel::PPPort::isGRAPH(ord(" ")));
1353
1354 ok(  Devel::PPPort::isGRAPH_A(ord("i")));
1355 ok(! Devel::PPPort::isGRAPH_A(0xB6));
1356
1357 ok(  Devel::PPPort::isPUNCT(ord("#")));
1358 ok(! Devel::PPPort::isPUNCT(ord(" ")));
1359
1360 ok(  Devel::PPPort::isPUNCT_A(ord("*")));
1361 ok(! Devel::PPPort::isPUNCT_A(0xB6));
1362
1363 ok(  Devel::PPPort::isXDIGIT(ord("A")));
1364 ok(! Devel::PPPort::isXDIGIT(ord("_")));
1365
1366 ok(  Devel::PPPort::isXDIGIT_A(ord("9")));
1367 ok(! Devel::PPPort::isXDIGIT_A(0xDC));
1368
1369 ok(  Devel::PPPort::isPSXSPC(ord(" ")));
1370 ok(! Devel::PPPort::isPSXSPC(ord("k")));
1371
1372 ok(  Devel::PPPort::isPSXSPC_A(ord("\cK")));
1373 ok(! Devel::PPPort::isPSXSPC_A(0xFC));
1374
1375 ok(&Devel::PPPort::av_top_index([1,2,3]), 2);
1376 ok(&Devel::PPPort::av_tindex([1,2,3,4]), 3);