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