This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
isPSXSPC() is a synonym for isSPACE
[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 PERLIO_FUNCS_CAST
21 PERLIO_FUNCS_DECL
22 PERL_UNUSED_ARG
23 PERL_UNUSED_CONTEXT
24 PERL_UNUSED_DECL
25 PERL_UNUSED_RESULT
26 PERL_UNUSED_VAR
27 PERL_USE_GCC_BRACE_GROUPS
28 PTR2ul
29 PTRV
30 START_EXTERN_C
31 STMT_END
32 STMT_START
33 SvRX
34 WIDEST_UTYPE
35 XSRETURN
36
37 =implementation
38
39 __UNDEFINED__ cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
40 __UNDEFINED__ OpHAS_SIBLING(o)      (cBOOL((o)->op_sibling))
41 __UNDEFINED__ OpSIBLING(o)          (0 + (o)->op_sibling)
42 __UNDEFINED__ OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
43 __UNDEFINED__ OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
44 __UNDEFINED__ OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
45 __UNDEFINED__ HEf_SVKEY   -2
46
47 #if defined(DEBUGGING) && !defined(__COVERITY__)
48 __UNDEFINED__ __ASSERT_(statement)  assert(statement),
49 #else
50 __UNDEFINED__ __ASSERT_(statement)
51 #endif
52
53 /* These could become provided when they become part of the public API */
54 __UNDEF_NOT_PROVIDED__ withinCOUNT(c, l, n)                                 \
55    (((WIDEST_UTYPE) (((c)) - ((l) | 0))) <= (((WIDEST_UTYPE) ((n) | 0))))
56 __UNDEF_NOT_PROVIDED__ inRANGE(c, l, u)                                    \
57    (  (sizeof(c) == sizeof(U8))  ? withinCOUNT(((U8)  (c)), (l), ((u) - (l)))  \
58     : (sizeof(c) == sizeof(U16)) ? withinCOUNT(((U16) (c)), (l), ((u) - (l)))  \
59     : (sizeof(c) == sizeof(U32)) ? withinCOUNT(((U32) (c)), (l), ((u) - (l)))  \
60     : (withinCOUNT(((WIDEST_UTYPE) (c)), (l), ((u) - (l)))))
61
62 /* Create the macro for "is'macro'_utf8_safe(s, e)".  For code points below
63  * 256, it calls the equivalent _L1 macro by converting the UTF-8 to code
64  * point.  That is so that it can automatically get the bug fixes done in this
65  * file. */
66 #define D_PPP_IS_GENERIC_UTF8_SAFE(s, e, macro)                             \
67    (((e) - (s)) <= 0                                                        \
68      ? 0                                                                    \
69      : UTF8_IS_INVARIANT((s)[0])                                            \
70        ? is ## macro ## _L1((s)[0])                                         \
71        : (((e) - (s)) < UTF8SKIP(s))                                        \
72           ? 0                                                               \
73           : UTF8_IS_DOWNGRADEABLE_START((s)[0])                             \
74               /* The cast in the line below is only to silence warnings */  \
75             ? is ## macro ## _L1((WIDEST_UTYPE) LATIN1_TO_NATIVE(           \
76                                   UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \
77                                                      & UTF_START_MASK(2),   \
78                                                   (s)[1])))                 \
79             : is ## macro ## _utf8(s))
80
81 __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)
82 __UNDEFINED__ SvRXOK(sv) (!!SvRX(sv))
83
84 #ifndef PERL_UNUSED_DECL
85 #  ifdef HASATTRIBUTE
86 #    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
87 #      define PERL_UNUSED_DECL
88 #    else
89 #      define PERL_UNUSED_DECL __attribute__((unused))
90 #    endif
91 #  else
92 #    define PERL_UNUSED_DECL
93 #  endif
94 #endif
95
96 #ifndef PERL_UNUSED_ARG
97 #  if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
98 #    include <note.h>
99 #    define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
100 #  else
101 #    define PERL_UNUSED_ARG(x) ((void)x)
102 #  endif
103 #endif
104
105 #ifndef PERL_UNUSED_VAR
106 #  define PERL_UNUSED_VAR(x) ((void)x)
107 #endif
108
109 #ifndef PERL_UNUSED_CONTEXT
110 #  ifdef USE_ITHREADS
111 #    define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
112 #  else
113 #    define PERL_UNUSED_CONTEXT
114 #  endif
115 #endif
116
117 #ifndef PERL_UNUSED_RESULT
118 #  if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
119 #    define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
120 #  else
121 #    define PERL_UNUSED_RESULT(v) ((void)(v))
122 #  endif
123 #endif
124
125 __UNDEFINED__  NOOP          /*EMPTY*/(void)0
126 __UNDEFINED__  dNOOP         extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
127
128 #ifndef NVTYPE
129 #  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
130 #    define NVTYPE long double
131 #  else
132 #    define NVTYPE double
133 #  endif
134 typedef NVTYPE NV;
135 #endif
136
137 #ifndef INT2PTR
138 #  if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
139 #    define PTRV                  UV
140 #    define INT2PTR(any,d)        (any)(d)
141 #  else
142 #    if PTRSIZE == LONGSIZE
143 #      define PTRV                unsigned long
144 #    else
145 #      define PTRV                unsigned
146 #    endif
147 #    define INT2PTR(any,d)        (any)(PTRV)(d)
148 #  endif
149 #endif
150
151 #ifndef PTR2ul
152 #  if PTRSIZE == LONGSIZE
153 #    define PTR2ul(p)     (unsigned long)(p)
154 #  else
155 #    define PTR2ul(p)     INT2PTR(unsigned long,p)
156 #  endif
157 #endif
158
159 __UNDEFINED__  PTR2nat(p)      (PTRV)(p)
160 __UNDEFINED__  NUM2PTR(any,d)  (any)PTR2nat(d)
161 __UNDEFINED__  PTR2IV(p)       INT2PTR(IV,p)
162 __UNDEFINED__  PTR2UV(p)       INT2PTR(UV,p)
163 __UNDEFINED__  PTR2NV(p)       NUM2PTR(NV,p)
164
165 #undef START_EXTERN_C
166 #undef END_EXTERN_C
167 #undef EXTERN_C
168 #ifdef __cplusplus
169 #  define START_EXTERN_C extern "C" {
170 #  define END_EXTERN_C }
171 #  define EXTERN_C extern "C"
172 #else
173 #  define START_EXTERN_C
174 #  define END_EXTERN_C
175 #  define EXTERN_C extern
176 #endif
177
178 #if { VERSION < 5.004 } || defined(PERL_GCC_PEDANTIC)
179 #  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
180 __UNDEF_NOT_PROVIDED__  PERL_GCC_BRACE_GROUPS_FORBIDDEN
181 #  endif
182 #endif
183
184 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
185 #  ifndef PERL_USE_GCC_BRACE_GROUPS
186 #    define PERL_USE_GCC_BRACE_GROUPS
187 #  endif
188 #endif
189
190 #undef STMT_START
191 #undef STMT_END
192 #ifdef PERL_USE_GCC_BRACE_GROUPS
193 #  define STMT_START    (void)( /* gcc supports ``({ STATEMENTS; })'' */
194 #  define STMT_END      )
195 #else
196 #  if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
197 #    define STMT_START  if (1)
198 #    define STMT_END    else (void)0
199 #  else
200 #    define STMT_START  do
201 #    define STMT_END    while (0)
202 #  endif
203 #endif
204
205 __UNDEFINED__  boolSV(b)    ((b) ? &PL_sv_yes : &PL_sv_no)
206
207 /* DEFSV appears first in 5.004_56 */
208 __UNDEFINED__  DEFSV        GvSV(PL_defgv)
209 __UNDEFINED__  SAVE_DEFSV   SAVESPTR(GvSV(PL_defgv))
210 __UNDEFINED__  DEFSV_set(sv) (DEFSV = (sv))
211
212 /* Older perls (<=5.003) lack AvFILLp */
213 __UNDEFINED__  AvFILLp      AvFILL
214
215 __UNDEFINED__  av_tindex    AvFILL
216 __UNDEFINED__  av_top_index 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__  CPERLscope(x)   x
269
270 __UNDEFINED__  PERL_HASH(hash,str,len) \
271      STMT_START { \
272         const char *s_PeRlHaSh = str; \
273         I32 i_PeRlHaSh = len; \
274         U32 hash_PeRlHaSh = 0; \
275         while (i_PeRlHaSh--) \
276             hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
277         (hash) = hash_PeRlHaSh; \
278     } STMT_END
279
280 #ifndef PERLIO_FUNCS_DECL
281 # ifdef PERLIO_FUNCS_CONST
282 #  define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
283 #  define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
284 # else
285 #  define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
286 #  define PERLIO_FUNCS_CAST(funcs) (funcs)
287 # endif
288 #endif
289
290 /* provide these typedefs for older perls */
291 #if { VERSION < 5.9.3 }
292
293 # ifdef ARGSproto
294 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
295 # else
296 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
297 # endif
298
299 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
300
301 #endif
302
303 #ifndef WIDEST_UTYPE
304 # ifdef QUADKIND
305 #  ifdef U64TYPE
306 #   define WIDEST_UTYPE U64TYPE
307 #  else
308 #   define WIDEST_UTYPE Quad_t
309 #  endif
310 # else
311 #  define WIDEST_UTYPE U32
312 # endif
313 #endif
314
315 /* On versions without NATIVE_TO_ASCII, only ASCII is supported */
316 #if defined(EBCDIC) && defined(NATIVE_TO_ASCI)
317 __UNDEFINED__ NATIVE_TO_LATIN1(c) NATIVE_TO_ASCII(c)
318 __UNDEFINED__ LATIN1_TO_NATIVE(c) ASCII_TO_NATIVE(c)
319 __UNDEFINED__ NATIVE_TO_UNI(c) ((c) > 255 ? (c) : NATIVE_TO_LATIN1(c))
320 __UNDEFINED__ UNI_TO_NATIVE(c) ((c) > 255 ? (c) : LATIN1_TO_NATIVE(c))
321 #else
322 __UNDEFINED__ NATIVE_TO_LATIN1(c) (c)
323 __UNDEFINED__ LATIN1_TO_NATIVE(c) (c)
324 __UNDEFINED__ NATIVE_TO_UNI(c) (c)
325 __UNDEFINED__ UNI_TO_NATIVE(c) (c)
326 #endif
327
328 /* Warning: LATIN1_TO_NATIVE, NATIVE_TO_LATIN1 NATIVE_TO_UNI UNI_TO_NATIVE
329    EBCDIC is not supported on versions earlier than 5.7.1
330  */
331
332 /* The meaning of this changed; use the modern version */
333 #undef isPSXSPC
334 #undef isPSXSPC_A
335 #undef isPSXSPC_L1
336
337 /* Hint: isPSXSPC, isPSXSPC_A, isPSXSPC_L1, isPSXSPC_utf8_safe
338     This is equivalent to the corresponding isSPACE-type macro.  On perls
339     before 5.18, this matched a vertical tab and SPACE didn't.  But the
340     ppport.h SPACE version does match VT in all perl releases.  Since VT's are
341     extremely rarely found in real-life files, this difference effectively
342     doesn't matter */
343
344 /* Hint: isSPACE, isSPACE_A, isSPACE_L1, isSPACE_utf8_safe
345     Until Perl 5.18, this did not match the vertical tab (VT).  The ppport.h
346     version does match it in all perl releases. Since VT's are extremely rarely
347     found in real-life files, this difference effectively doesn't matter */
348
349 #ifdef EBCDIC
350
351 /* This is the first version where these macros are fully correct on EBCDIC
352  * platforms.  Relying on * the C library functions, as earlier releases did,
353  * causes problems with * locales */
354 # if { VERSION < 5.22.0 }
355 #  undef isALNUM
356 #  undef isALNUM_A
357 #  undef isALNUM_L1
358 #  undef isALNUMC
359 #  undef isALNUMC_A
360 #  undef isALNUMC_L1
361 #  undef isALPHA
362 #  undef isALPHA_A
363 #  undef isALPHA_L1
364 #  undef isALPHANUMERIC
365 #  undef isALPHANUMERIC_A
366 #  undef isALPHANUMERIC_L1
367 #  undef isASCII
368 #  undef isASCII_A
369 #  undef isASCII_L1
370 #  undef isBLANK
371 #  undef isBLANK_A
372 #  undef isBLANK_L1
373 #  undef isCNTRL
374 #  undef isCNTRL_A
375 #  undef isCNTRL_L1
376 #  undef isDIGIT
377 #  undef isDIGIT_A
378 #  undef isDIGIT_L1
379 #  undef isGRAPH
380 #  undef isGRAPH_A
381 #  undef isGRAPH_L1
382 #  undef isIDCONT
383 #  undef isIDCONT_A
384 #  undef isIDCONT_L1
385 #  undef isIDFIRST
386 #  undef isIDFIRST_A
387 #  undef isIDFIRST_L1
388 #  undef isLOWER
389 #  undef isLOWER_A
390 #  undef isLOWER_L1
391 #  undef isOCTAL
392 #  undef isOCTAL_A
393 #  undef isOCTAL_L1
394 #  undef isPRINT
395 #  undef isPRINT_A
396 #  undef isPRINT_L1
397 #  undef isPUNCT
398 #  undef isPUNCT_A
399 #  undef isPUNCT_L1
400 #  undef isSPACE
401 #  undef isSPACE_A
402 #  undef isSPACE_L1
403 #  undef isUPPER
404 #  undef isUPPER_A
405 #  undef isUPPER_L1
406 #  undef isWORDCHAR
407 #  undef isWORDCHAR_A
408 #  undef isWORDCHAR_L1
409 #  undef isXDIGIT
410 #  undef isXDIGIT_A
411 #  undef isXDIGIT_L1
412 # endif
413
414 __UNDEFINED__ isASCII(c)    (isCNTRL(c) || isPRINT(c))
415
416         /* The below is accurate for all EBCDIC code pages supported by
417          * all the versions of Perl overridden by this */
418 __UNDEFINED__ isCNTRL(c)    (    (c) == '\0' || (c) == '\a' || (c) == '\b'      \
419                              ||  (c) == '\f' || (c) == '\n' || (c) == '\r'      \
420                              ||  (c) == '\t' || (c) == '\v'                     \
421                              || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */      \
422                              ||  (c) == 7    /* U+7F DEL */                     \
423                              || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */       \
424                                                       /* DLE, DC[1-3] */        \
425                              ||  (c) == 0x18 /* U+18 CAN */                     \
426                              ||  (c) == 0x19 /* U+19 EOM */                     \
427                              || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */      \
428                              ||  (c) == 0x26 /* U+17 ETB */                     \
429                              ||  (c) == 0x27 /* U+1B ESC */                     \
430                              ||  (c) == 0x2D /* U+05 ENQ */                     \
431                              ||  (c) == 0x2E /* U+06 ACK */                     \
432                              ||  (c) == 0x32 /* U+16 SYN */                     \
433                              ||  (c) == 0x37 /* U+04 EOT */                     \
434                              ||  (c) == 0x3C /* U+14 DC4 */                     \
435                              ||  (c) == 0x3D /* U+15 NAK */                     \
436                              ||  (c) == 0x3F /* U+1A SUB */                     \
437                             )
438
439 #if '^' == 106    /* EBCDIC POSIX-BC */
440 #  define D_PPP_OUTLIER_CONTROL 0x5F
441 #else   /* EBCDIC 1047 037 */
442 #  define D_PPP_OUTLIER_CONTROL 0xFF
443 #endif
444
445 /* The controls are everything below blank, plus one outlier */
446 __UNDEFINED__ isCNTRL_L1(c) ((WIDEST_UTYPE) (c) < ' '                           \
447                           || (WIDEST_UTYPE) (c) == D_PPP_OUTLIER_CONTROL)
448 /* The ordering of the tests in this and isUPPER are to exclude most characters
449  * early */
450 __UNDEFINED__ isLOWER(c)    (        (c) >= 'a' && (c) <= 'z'                   \
451                              &&  (   (c) <= 'i'                                 \
452                                  || ((c) >= 'j' && (c) <= 'r')                  \
453                                  ||  (c) >= 's'))
454 __UNDEFINED__ isUPPER(c)    (        (c) >= 'A' && (c) <= 'Z'                   \
455                              && (    (c) <= 'I'                                 \
456                                  || ((c) >= 'J' && (c) <= 'R')                  \
457                                  ||  (c) >= 'S'))
458
459 #else   /* Above is EBCDIC; below is ASCII */
460
461 # if { VERSION < 5.4.0 }
462 /* The implementation of these in older perl versions can give wrong results if
463  * the C program locale is set to other than the C locale */
464 #  undef isALNUM
465 #  undef isALNUM_A
466 #  undef isALPHA
467 #  undef isALPHA_A
468 #  undef isDIGIT
469 #  undef isDIGIT_A
470 #  undef isIDFIRST
471 #  undef isIDFIRST_A
472 #  undef isLOWER
473 #  undef isLOWER_A
474 #  undef isUPPER
475 #  undef isUPPER_A
476 # endif
477
478 # if { VERSION < 5.8.0 } /* earlier perls omitted DEL */
479 #  undef isCNTRL
480 # endif
481
482 # if { VERSION < 5.10.0 }
483 /* earlier perls included all of the isSPACE() characters, which is wrong. The
484  * version provided by Devel::PPPort always overrides an existing buggy
485  * version. */
486 #  undef isPRINT
487 #  undef isPRINT_A
488 # endif
489
490 # if { VERSION < 5.14.0 }
491 /* earlier perls always returned true if the parameter was a signed char */
492 #  undef isASCII
493 #  undef isASCII_A
494 # endif
495
496 # if { VERSION < 5.17.8 } /* earlier perls didn't include PILCROW, SECTION SIGN */
497 #  undef isPUNCT_L1
498 # endif
499
500 # if { VERSION < 5.13.7 } /* khw didn't investigate why this failed */
501 #  undef isALNUMC_L1
502 #endif
503
504 # if { VERSION < 5.20.0 } /* earlier perls didn't include \v */
505 #  undef isSPACE
506 #  undef isSPACE_A
507 #  undef isSPACE_L1
508
509 # endif
510
511 __UNDEFINED__ isASCII(c)        ((WIDEST_UTYPE) (c) <= 127)
512 __UNDEFINED__ isCNTRL(c)        ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
513 __UNDEFINED__ isCNTRL_L1(c)     (isCNTRL(c) || (   (WIDEST_UTYPE) (c) <= 0x9F  \
514                                                 && (WIDEST_UTYPE) (c) >= 0x80))
515 __UNDEFINED__ isLOWER(c)        ((c) >= 'a' && (c) <= 'z')
516 __UNDEFINED__ isUPPER(c)        ((c) <= 'Z' && (c) >= 'A')
517
518 #endif /* Below are definitions common to EBCDIC and ASCII */
519
520 __UNDEFINED__ isASCII_L1(c)     isASCII(c)
521 __UNDEFINED__ isALNUM(c)        isWORDCHAR(c)
522 __UNDEFINED__ isALNUMC(c)       isALPHANUMERIC(c)
523 __UNDEFINED__ isALNUMC_L1(c)    isALPHANUMERIC_L1(c)
524 __UNDEFINED__ isALPHA(c)        (isUPPER(c) || isLOWER(c))
525 __UNDEFINED__ isALPHA_L1(c)     (isUPPER_L1(c) || isLOWER_L1(c))
526 __UNDEFINED__ isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c))
527 __UNDEFINED__ isALPHANUMERIC_L1(c) (isALPHA_L1(c) || isDIGIT(c))
528 __UNDEFINED__ isBLANK(c)        ((c) == ' ' || (c) == '\t')
529 __UNDEFINED__ isBLANK_L1(c) (    isBLANK(c)                                    \
530                              || (   (WIDEST_UTYPE) (c) < 256                   \
531                                  && NATIVE_TO_LATIN1((U8) c) == 0xA0))
532 __UNDEFINED__ isDIGIT(c)        ((c) <= '9' && (c) >= '0')
533 __UNDEFINED__ isDIGIT_L1(c)     isDIGIT(c)
534 __UNDEFINED__ isGRAPH(c)        (isWORDCHAR(c) || isPUNCT(c))
535 __UNDEFINED__ isGRAPH_L1(c)     (   isPRINT_L1(c)                              \
536                                  && (c) != ' '                                 \
537                                  && NATIVE_TO_LATIN1((U8) c) != 0xA0)
538 __UNDEFINED__ isIDCONT(c)       isWORDCHAR(c)
539 __UNDEFINED__ isIDCONT_L1(c)    isWORDCHAR_L1(c)
540 __UNDEFINED__ isIDFIRST(c)      (isALPHA(c) || (c) == '_')
541 __UNDEFINED__ isIDFIRST_L1(c)   (isALPHA_L1(c) || NATIVE_TO_LATIN1(c) == '_')
542 __UNDEFINED__ isLOWER_L1(c) (    isLOWER(c)                                    \
543                              || (   (WIDEST_UTYPE) (c) < 256                   \
544                                  && (  (   NATIVE_TO_LATIN1((U8) c) >= 0xDF    \
545                                         && NATIVE_TO_LATIN1((U8) c) != 0xF7)   \
546                                      || NATIVE_TO_LATIN1((U8) c) == 0xAA       \
547                                      || NATIVE_TO_LATIN1((U8) c) == 0xBA       \
548                                      || NATIVE_TO_LATIN1((U8) c) == 0xB5)))
549 __UNDEFINED__ isOCTAL(c)        (((WIDEST_UTYPE)((c)) & ~7) == '0')
550 __UNDEFINED__ isOCTAL_L1(c)     isOCTAL(c)
551 __UNDEFINED__ isPRINT(c)        (isGRAPH(c) || (c) == ' ')
552 __UNDEFINED__ isPRINT_L1(c)     ((WIDEST_UTYPE) (c) < 256 && ! isCNTRL_L1(c))
553 __UNDEFINED__ isPSXSPC(c)       isSPACE(c)
554 __UNDEFINED__ isPSXSPC_L1(c)    isSPACE_L1(c)
555 __UNDEFINED__ isPUNCT(c)    (   (c) == '-' || (c) == '!' || (c) == '"'         \
556                              || (c) == '#' || (c) == '$' || (c) == '%'         \
557                              || (c) == '&' || (c) == '\'' || (c) == '('        \
558                              || (c) == ')' || (c) == '*' || (c) == '+'         \
559                              || (c) == ',' || (c) == '.' || (c) == '/'         \
560                              || (c) == ':' || (c) == ';' || (c) == '<'         \
561                              || (c) == '=' || (c) == '>' || (c) == '?'         \
562                              || (c) == '@' || (c) == '[' || (c) == '\\'        \
563                              || (c) == ']' || (c) == '^' || (c) == '_'         \
564                              || (c) == '`' || (c) == '{' || (c) == '|'         \
565                              || (c) == '}' || (c) == '~')
566 __UNDEFINED__ isPUNCT_L1(c)  (    isPUNCT(c)                                   \
567                               || (   (WIDEST_UTYPE) (c) < 256                  \
568                                   && (   NATIVE_TO_LATIN1((U8) c) == 0xA1      \
569                                       || NATIVE_TO_LATIN1((U8) c) == 0xA7      \
570                                       || NATIVE_TO_LATIN1((U8) c) == 0xAB      \
571                                       || NATIVE_TO_LATIN1((U8) c) == 0xB6      \
572                                       || NATIVE_TO_LATIN1((U8) c) == 0xB7      \
573                                       || NATIVE_TO_LATIN1((U8) c) == 0xBB      \
574                                       || NATIVE_TO_LATIN1((U8) c) == 0xBF)))
575 __UNDEFINED__ isSPACE(c)        (   isBLANK(c) || (c) == '\n' || (c) == '\r'   \
576                                  || (c) == '\v' || (c) == '\f')
577 __UNDEFINED__ isSPACE_L1(c) (    isSPACE(c)                                    \
578                              || (   (WIDEST_UTYPE) (c) < 256                   \
579                                  && (   NATIVE_TO_LATIN1((U8) c) == 0x85       \
580                                      || NATIVE_TO_LATIN1((U8) c) == 0xA0)))
581 __UNDEFINED__ isUPPER_L1(c) (   isUPPER(c)                                     \
582                              || (   (WIDEST_UTYPE) (c) < 256                   \
583                                  && (   NATIVE_TO_LATIN1((U8) c) >= 0xC0       \
584                                      && NATIVE_TO_LATIN1((U8) c) <= 0xDE       \
585                                      && NATIVE_TO_LATIN1((U8) c) != 0xD7)))
586 __UNDEFINED__ isWORDCHAR(c)     (isALPHANUMERIC(c) || (c) == '_')
587 __UNDEFINED__ isWORDCHAR_L1(c)  (isIDFIRST_L1(c) || isDIGIT(c))
588 __UNDEFINED__ isXDIGIT(c)       (   isDIGIT(c)                                 \
589                                  || ((c) >= 'a' && (c) <= 'f')                 \
590                                  || ((c) >= 'A' && (c) <= 'F'))
591 __UNDEFINED__ isXDIGIT_L1(c)    isXDIGIT(c)
592
593 __UNDEFINED__ isALNUM_A(c)         isALNUM(c)
594 __UNDEFINED__ isALNUMC_A(c)        isALNUMC(c)
595 __UNDEFINED__ isALPHA_A(c)         isALPHA(c)
596 __UNDEFINED__ isALPHANUMERIC_A(c)  isALPHANUMERIC(c)
597 __UNDEFINED__ isASCII_A(c)         isASCII(c)
598 __UNDEFINED__ isBLANK_A(c)         isBLANK(c)
599 __UNDEFINED__ isCNTRL_A(c)         isCNTRL(c)
600 __UNDEFINED__ isDIGIT_A(c)         isDIGIT(c)
601 __UNDEFINED__ isGRAPH_A(c)         isGRAPH(c)
602 __UNDEFINED__ isIDCONT_A(c)        isIDCONT(c)
603 __UNDEFINED__ isIDFIRST_A(c)       isIDFIRST(c)
604 __UNDEFINED__ isLOWER_A(c)         isLOWER(c)
605 __UNDEFINED__ isOCTAL_A(c)         isOCTAL(c)
606 __UNDEFINED__ isPRINT_A(c)         isPRINT(c)
607 __UNDEFINED__ isPSXSPC_A(c)        isPSXSPC(c)
608 __UNDEFINED__ isPUNCT_A(c)         isPUNCT(c)
609 __UNDEFINED__ isSPACE_A(c)         isSPACE(c)
610 __UNDEFINED__ isUPPER_A(c)         isUPPER(c)
611 __UNDEFINED__ isWORDCHAR_A(c)      isWORDCHAR(c)
612 __UNDEFINED__ isXDIGIT_A(c)        isXDIGIT(c)
613
614 __UNDEFINED__ isASCII_utf8_safe(s,e)  isASCII(*(s))
615
616 #if { VERSION >= 5.006 }
617
618 __UNDEFINED__ isALPHA_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHA)
619 #  ifdef isALPHANUMERIC_utf8
620 __UNDEFINED__ isALPHANUMERIC_utf8_safe(s,e)                                 \
621                                 D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHANUMERIC)
622 #  else
623 __UNDEFINED__ isALPHANUMERIC_utf8_safe(s,e)                                 \
624                         (isALPHA_utf8_safe(s,e) || isDIGIT_utf8_safe(s,e))
625 #  endif
626
627 /* This was broken before 5.18, and just use this instead of worrying about
628  * which releases the official works on */
629 #  if 'A' == 65
630 __UNDEFINED__  isBLANK_utf8_safe(s,e)                                       \
631 ( ( LIKELY((e) > (s)) ) ?   /* Machine generated */                         \
632     ( ( 0x09 == ((const U8*)s)[0] || 0x20 == ((const U8*)s)[0] ) ? 1        \
633     : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ?                              \
634             ( ( 0xC2 == ((const U8*)s)[0] ) ?                               \
635                 ( ( 0xA0 == ((const U8*)s)[1] ) ? 2 : 0 )                   \
636             : ( 0xE1 == ((const U8*)s)[0] ) ?                               \
637                 ( ( ( 0x9A == ((const U8*)s)[1] ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
638             : ( 0xE2 == ((const U8*)s)[0] ) ?                               \
639                 ( ( 0x80 == ((const U8*)s)[1] ) ?                           \
640                     ( ( inRANGE(((const U8*)s)[2], 0x80, 0x8A ) || 0xAF == ((const U8*)s)[2] ) ? 3 : 0 )\
641                 : ( ( 0x81 == ((const U8*)s)[1] ) && ( 0x9F == ((const U8*)s)[2] ) ) ? 3 : 0 )\
642             : ( ( ( 0xE3 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
643         : 0 )                                                               \
644  : 0 )
645
646 #  elif 'A' == 193  && '^' == 95 /* EBCDIC 1047 */
647
648 __UNDEFINED__  isBLANK_utf8_safe(s,e)                                       \
649 ( ( LIKELY((e) > (s)) ) ?                                                   \
650     ( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1        \
651     : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ?                              \
652             ( ( 0x80 == ((const U8*)s)[0] ) ?                               \
653                 ( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 )                   \
654             : ( 0xBC == ((const U8*)s)[0] ) ?                               \
655                 ( ( ( 0x63 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
656             : ( 0xCA == ((const U8*)s)[0] ) ?                               \
657                 ( ( 0x41 == ((const U8*)s)[1] ) ?                           \
658                     ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\
659                 : ( 0x42 == ((const U8*)s)[1] ) ?                           \
660                     ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 )               \
661                 : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x73 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
662             : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
663         : 0 )                                                               \
664 : 0 )
665
666 #  elif 'A' == 193  && '^' == 176 /* EBCDIC 037 */
667
668 __UNDEFINED__  isBLANK_utf8_safe(s,e)                                       \
669 ( ( LIKELY((e) > (s)) ) ?                                                   \
670     ( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1        \
671     : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ?                              \
672             ( ( 0x78 == ((const U8*)s)[0] ) ?                               \
673                 ( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 )                   \
674             : ( 0xBD == ((const U8*)s)[0] ) ?                               \
675                 ( ( ( 0x62 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
676             : ( 0xCA == ((const U8*)s)[0] ) ?                               \
677                 ( ( 0x41 == ((const U8*)s)[1] ) ?                           \
678                     ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\
679                 : ( 0x42 == ((const U8*)s)[1] ) ?                           \
680                     ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 )               \
681                 : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
682             : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
683         : 0 )                                                               \
684 : 0 )
685
686 #  else
687 #    error Unknown character set
688 #  endif
689
690 __UNDEFINED__ isCNTRL_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, CNTRL)
691 __UNDEFINED__ isDIGIT_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, DIGIT)
692 __UNDEFINED__ isGRAPH_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, GRAPH)
693 #  ifdef isIDCONT_utf8
694 __UNDEFINED__ isIDCONT_utf8_safe(s,e)   D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDCONT)
695 #  else
696 __UNDEFINED__ isIDCONT_utf8_safe(s,e)   isWORDCHAR_utf8_safe(s,e)
697 #  endif
698
699 __UNDEFINED__ isIDFIRST_utf8_safe(s,e)  D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDFIRST)
700 __UNDEFINED__ isLOWER_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, LOWER)
701 __UNDEFINED__ isPRINT_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PRINT)
702
703 #  undef isPSXSPC_utf8_safe   /* Use the modern definition */
704 __UNDEFINED__ isPSXSPC_utf8_safe(s,e)   isSPACE_utf8_safe(s,e)
705
706 __UNDEFINED__ isPUNCT_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PUNCT)
707 __UNDEFINED__ isSPACE_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, SPACE)
708 __UNDEFINED__ isUPPER_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, UPPER)
709
710 #  ifdef isWORDCHAR_utf8
711 __UNDEFINED__ isWORDCHAR_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, WORDCHAR)
712 #  else
713 __UNDEFINED__ isWORDCHAR_utf8_safe(s,e)                                        \
714                                (isALPHANUMERIC_utf8_safe(s,e) || (*(s)) == '_')
715 #  endif
716
717 /* This was broken before 5.12, and just use this instead of worrying about
718  * which releases the official works on */
719 #  if 'A' == 65
720 __UNDEFINED__  isXDIGIT_utf8_safe(s,e)                                       \
721 ( ( LIKELY((e) > (s)) ) ?                                                   \
722     ( ( inRANGE(((const U8*)s)[0], 0x30, 0x39 ) || inRANGE(((const U8*)s)[0], 0x41, 0x46 ) || inRANGE(((const U8*)s)[0], 0x61, 0x66 ) ) ? 1\
723     : ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xEF == ((const U8*)s)[0] ) ) ? ( ( 0xBC == ((const U8*)s)[1] ) ?\
724                     ( ( inRANGE(((const U8*)s)[2], 0x90, 0x99 ) || inRANGE(((const U8*)s)[2], 0xA1, 0xA6 ) ) ? 3 : 0 )\
725                 : ( ( 0xBD == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x81, 0x86 ) ) ) ? 3 : 0 ) : 0 )\
726 : 0 )
727
728 #  elif 'A' == 193  && '^' == 95 /* EBCDIC 1047 */
729
730 __UNDEFINED__  isXDIGIT_utf8_safe(s,e)                                       \
731 ( ( LIKELY((e) > (s)) ) ?                                                   \
732     ( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\
733     : ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x73 == ((const U8*)s)[1] ) ) ? ( ( 0x67 == ((const U8*)s)[2] ) ?\
734                         ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || inRANGE(((const U8*)s)[3], 0x62, 0x68 ) ) ? 4 : 0 )\
735                     : ( ( inRANGE(((const U8*)s)[2], 0x68, 0x69 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
736 : 0 )
737
738 #  elif 'A' == 193  && '^' == 176 /* EBCDIC 037 */
739
740 __UNDEFINED__  isXDIGIT_utf8_safe(s,e)                                       \
741 ( ( LIKELY((e) > (s)) ) ?                                                   \
742     ( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\
743     : ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x72 == ((const U8*)s)[1] ) ) ? ( ( 0x66 == ((const U8*)s)[2] ) ?\
744                         ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x67 ) ) ? 4 : 0 )\
745                     : ( ( inRANGE(((const U8*)s)[2], 0x67, 0x68 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
746 : 0 )
747
748 #  else
749 #    error Unknown character set
750 #  endif
751 #endif
752
753
754 /* Until we figure out how to support this in older perls... */
755 #if { VERSION >= 5.8.0 }
756
757 __UNDEFINED__ HeUTF8(he)        ((HeKLEN(he) == HEf_SVKEY) ?            \
758                                  SvUTF8(HeKEY_sv(he)) :                 \
759                                  (U32)HeKUTF8(he))
760
761 #endif
762
763 __UNDEFINED__ C_ARRAY_LENGTH(a)         (sizeof(a)/sizeof((a)[0]))
764 __UNDEFINED__ C_ARRAY_END(a)            ((a) + C_ARRAY_LENGTH(a))
765
766 __UNDEFINED__ LIKELY(x) (x)
767 __UNDEFINED__ UNLIKELY(x) (x)
768
769 #ifndef MUTABLE_PTR
770 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
771 #  define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
772 #else
773 #  define MUTABLE_PTR(p) ((void *) (p))
774 #endif
775 #endif
776
777 __UNDEFINED__ MUTABLE_SV(p)   ((SV *)MUTABLE_PTR(p))
778
779 =xsmisc
780
781 typedef XSPROTO(XSPROTO_test_t);
782 typedef XSPROTO_test_t *XSPROTO_test_t_ptr;
783
784 XS(XS_Devel__PPPort_dXSTARG);  /* prototype */
785 XS(XS_Devel__PPPort_dXSTARG)
786 {
787   dXSARGS;
788   dXSTARG;
789   IV iv;
790
791   PERL_UNUSED_VAR(cv);
792   SP -= items;
793   iv = SvIV(ST(0)) + 1;
794   PUSHi(iv);
795   XSRETURN(1);
796 }
797
798 XS(XS_Devel__PPPort_dAXMARK);  /* prototype */
799 XS(XS_Devel__PPPort_dAXMARK)
800 {
801   dSP;
802   dAXMARK;
803   dITEMS;
804   IV iv;
805
806   PERL_UNUSED_VAR(cv);
807   SP -= items;
808   iv = SvIV(ST(0)) - 1;
809   mPUSHi(iv);
810   XSRETURN(1);
811 }
812
813 =xsboot
814
815 {
816   XSPROTO_test_t_ptr p = &XS_Devel__PPPort_dXSTARG;
817   newXS("Devel::PPPort::dXSTARG", *p, file);
818 }
819 newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
820
821 =xsubs
822
823 int
824 OpSIBLING_tests()
825         PREINIT:
826                 OP *x;
827                 OP *kid;
828                 OP *middlekid;
829                 OP *lastkid;
830                 int count = 0;
831                 int failures = 0;
832                 int i;
833         CODE:
834                 x = newOP(OP_PUSHMARK, 0);
835
836                 /* No siblings yet! */
837                 if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
838                         failures++; warn("Op should not have had a sib");
839                 }
840
841
842                 /* Add 2 siblings */
843                 kid = x;
844
845                 for (i = 0; i < 2; i++) {
846                         OP *newsib = newOP(OP_PUSHMARK, 0);
847                         OpMORESIB_set(kid, newsib);
848
849                         kid = OpSIBLING(kid);
850                         lastkid = kid;
851                 }
852                 middlekid = OpSIBLING(x);
853
854                 /* Should now have a sibling */
855                 if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
856                         failures++; warn("Op should have had a sib after moresib_set");
857                 }
858
859                 /* Count the siblings */
860                 for (kid = OpSIBLING(x); kid; kid = OpSIBLING(kid)) {
861                         count++;
862                 }
863
864                 if (count != 2) {
865                         failures++; warn("Kid had %d sibs, expected 2", count);
866                 }
867
868                 if (OpHAS_SIBLING(lastkid) || OpSIBLING(lastkid)) {
869                         failures++; warn("Last kid should not have a sib");
870                 }
871
872                 /* Really sets the parent, and says 'no more siblings' */
873                 OpLASTSIB_set(x, lastkid);
874
875                 if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
876                         failures++; warn("OpLASTSIB_set failed?");
877                 }
878
879                 /* Restore the kid */
880                 OpMORESIB_set(x, lastkid);
881
882                 /* Try to remove it again */
883                 OpLASTSIB_set(x, NULL);
884
885                 if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
886                         failures++; warn("OpLASTSIB_set with NULL failed?");
887                 }
888
889                 /* Try to restore with maybesib_set */
890                 OpMAYBESIB_set(x, lastkid, NULL);
891
892                 if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
893                         failures++; warn("Op should have had a sib after maybesibset");
894                 }
895
896                 op_free(lastkid);
897                 op_free(middlekid);
898                 op_free(x);
899                 RETVAL = failures;
900         OUTPUT:
901                 RETVAL
902
903 int
904 SvRXOK(sv)
905         SV *sv
906         CODE:
907                 RETVAL = SvRXOK(sv);
908         OUTPUT:
909                 RETVAL
910
911 int
912 ptrtests()
913         PREINIT:
914                 int var, *p = &var;
915
916         CODE:
917                 RETVAL = 0;
918                 RETVAL += PTR2nat(p) != 0       ?  1 : 0;
919                 RETVAL += PTR2ul(p) != 0UL      ?  2 : 0;
920                 RETVAL += PTR2UV(p) != (UV) 0   ?  4 : 0;
921                 RETVAL += PTR2IV(p) != (IV) 0   ?  8 : 0;
922                 RETVAL += PTR2NV(p) != (NV) 0   ? 16 : 0;
923                 RETVAL += p > NUM2PTR(int *, 0) ? 32 : 0;
924
925         OUTPUT:
926                 RETVAL
927
928 int
929 gv_stashpvn(name, create)
930         char *name
931         I32 create
932         CODE:
933                 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
934         OUTPUT:
935                 RETVAL
936
937 int
938 get_sv(name, create)
939         char *name
940         I32 create
941         CODE:
942                 RETVAL = get_sv(name, create) != NULL;
943         OUTPUT:
944                 RETVAL
945
946 int
947 get_av(name, create)
948         char *name
949         I32 create
950         CODE:
951                 RETVAL = get_av(name, create) != NULL;
952         OUTPUT:
953                 RETVAL
954
955 int
956 get_hv(name, create)
957         char *name
958         I32 create
959         CODE:
960                 RETVAL = get_hv(name, create) != NULL;
961         OUTPUT:
962                 RETVAL
963
964 int
965 get_cv(name, create)
966         char *name
967         I32 create
968         CODE:
969                 RETVAL = get_cv(name, create) != NULL;
970         OUTPUT:
971                 RETVAL
972
973 void
974 xsreturn(two)
975         int two
976         PPCODE:
977                 mXPUSHp("test1", 5);
978                 if (two)
979                   mXPUSHp("test2", 5);
980                 if (two)
981                   XSRETURN(2);
982                 else
983                   XSRETURN(1);
984
985 SV*
986 boolSV(value)
987         int value
988         CODE:
989                 RETVAL = newSVsv(boolSV(value));
990         OUTPUT:
991                 RETVAL
992
993 SV*
994 DEFSV()
995         CODE:
996                 RETVAL = newSVsv(DEFSV);
997         OUTPUT:
998                 RETVAL
999
1000 void
1001 DEFSV_modify()
1002         PPCODE:
1003                 XPUSHs(sv_mortalcopy(DEFSV));
1004                 ENTER;
1005                 SAVE_DEFSV;
1006                 DEFSV_set(newSVpvs("DEFSV"));
1007                 XPUSHs(sv_mortalcopy(DEFSV));
1008                 /* Yes, this leaks the above scalar; 5.005 with threads for some reason */
1009                 /* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */
1010                 /* sv_2mortal(DEFSV); */
1011                 LEAVE;
1012                 XPUSHs(sv_mortalcopy(DEFSV));
1013                 XSRETURN(3);
1014
1015 int
1016 ERRSV()
1017         CODE:
1018                 RETVAL = SvTRUEx(ERRSV);
1019         OUTPUT:
1020                 RETVAL
1021
1022 SV*
1023 UNDERBAR()
1024         CODE:
1025                 {
1026                   dUNDERBAR;
1027                   RETVAL = newSVsv(UNDERBAR);
1028                 }
1029         OUTPUT:
1030                 RETVAL
1031
1032 void
1033 prepush()
1034         CODE:
1035                 {
1036                   dXSTARG;
1037                   XSprePUSH;
1038                   PUSHi(42);
1039                   XSRETURN(1);
1040                 }
1041
1042 int
1043 PERL_ABS(a)
1044         int a
1045
1046 void
1047 SVf(x)
1048         SV *x
1049         PPCODE:
1050 #if { VERSION >= 5.004 }
1051                 x = sv_2mortal(newSVpvf("[%" SVf "]", SVfARG(x)));
1052 #endif
1053                 XPUSHs(x);
1054                 XSRETURN(1);
1055
1056 void
1057 Perl_ppaddr_t(string)
1058         char *string
1059         PREINIT:
1060                 Perl_ppaddr_t lower;
1061         PPCODE:
1062                 lower = PL_ppaddr[OP_LC];
1063                 mXPUSHs(newSVpv(string, 0));
1064                 PUTBACK;
1065                 ENTER;
1066                 (void)*(lower)(aTHXR);
1067                 SPAGAIN;
1068                 LEAVE;
1069                 XSRETURN(1);
1070
1071 #if { VERSION >= 5.8.0 }
1072
1073 void
1074 check_HeUTF8(utf8_key)
1075         SV *utf8_key;
1076         PREINIT:
1077                 HV *hash;
1078                 HE *ent;
1079                 STRLEN klen;
1080                 char *key;
1081         PPCODE:
1082                 hash = newHV();
1083
1084                 key = SvPV(utf8_key, klen);
1085                 if (SvUTF8(utf8_key)) klen *= -1;
1086                 hv_store(hash, key, klen, newSVpvs("string"), 0);
1087                 hv_iterinit(hash);
1088                 ent = hv_iternext(hash);
1089                 assert(ent);
1090                 mXPUSHp((HeUTF8(ent) == 0 ? "norm" : "utf8"), 4);
1091                 hv_undef(hash);
1092
1093
1094 #endif
1095
1096 void
1097 check_c_array()
1098         PREINIT:
1099                 int x[] = { 10, 11, 12, 13 };
1100         PPCODE:
1101                 mXPUSHi(C_ARRAY_LENGTH(x));  /* 4 */
1102                 mXPUSHi(*(C_ARRAY_END(x)-1)); /* 13 */
1103
1104 bool
1105 isBLANK(ord)
1106     UV ord
1107     CODE:
1108         RETVAL = isBLANK(ord);
1109     OUTPUT:
1110         RETVAL
1111
1112 bool
1113 isBLANK_A(ord)
1114     UV ord
1115     CODE:
1116         RETVAL = isBLANK_A(ord);
1117     OUTPUT:
1118         RETVAL
1119
1120 bool
1121 isBLANK_L1(ord)
1122     UV ord
1123     CODE:
1124         RETVAL = isBLANK_L1(ord);
1125     OUTPUT:
1126         RETVAL
1127
1128 bool
1129 isUPPER(ord)
1130     UV ord
1131     CODE:
1132         RETVAL = isUPPER(ord);
1133     OUTPUT:
1134         RETVAL
1135
1136 bool
1137 isUPPER_A(ord)
1138     UV ord
1139     CODE:
1140         RETVAL = isUPPER_A(ord);
1141     OUTPUT:
1142         RETVAL
1143
1144 bool
1145 isUPPER_L1(ord)
1146     UV ord
1147     CODE:
1148         RETVAL = isUPPER_L1(ord);
1149     OUTPUT:
1150         RETVAL
1151
1152 bool
1153 isLOWER(ord)
1154     UV ord
1155     CODE:
1156         RETVAL = isLOWER(ord);
1157     OUTPUT:
1158         RETVAL
1159
1160 bool
1161 isLOWER_A(ord)
1162     UV ord
1163     CODE:
1164         RETVAL = isLOWER_A(ord);
1165     OUTPUT:
1166         RETVAL
1167
1168 bool
1169 isLOWER_L1(ord)
1170     UV ord
1171     CODE:
1172         RETVAL = isLOWER_L1(ord);
1173     OUTPUT:
1174         RETVAL
1175
1176 bool
1177 isALPHA(ord)
1178     UV ord
1179     CODE:
1180         RETVAL = isALPHA(ord);
1181     OUTPUT:
1182         RETVAL
1183
1184 bool
1185 isALPHA_A(ord)
1186     UV ord
1187     CODE:
1188         RETVAL = isALPHA_A(ord);
1189     OUTPUT:
1190         RETVAL
1191
1192 bool
1193 isALPHA_L1(ord)
1194     UV ord
1195     CODE:
1196         RETVAL = isALPHA_L1(ord);
1197     OUTPUT:
1198         RETVAL
1199
1200 bool
1201 isWORDCHAR(ord)
1202     UV ord
1203     CODE:
1204         RETVAL = isWORDCHAR(ord);
1205     OUTPUT:
1206         RETVAL
1207
1208 bool
1209 isWORDCHAR_A(ord)
1210     UV ord
1211     CODE:
1212         RETVAL = isWORDCHAR_A(ord);
1213     OUTPUT:
1214         RETVAL
1215
1216 bool
1217 isWORDCHAR_L1(ord)
1218     UV ord
1219     CODE:
1220         RETVAL = isWORDCHAR_L1(ord);
1221     OUTPUT:
1222         RETVAL
1223
1224 bool
1225 isALPHANUMERIC(ord)
1226     UV ord
1227     CODE:
1228         RETVAL = isALPHANUMERIC(ord);
1229     OUTPUT:
1230         RETVAL
1231
1232 bool
1233 isALPHANUMERIC_A(ord)
1234     UV ord
1235     CODE:
1236         RETVAL = isALPHANUMERIC_A(ord);
1237     OUTPUT:
1238         RETVAL
1239
1240 bool
1241 isALNUM(ord)
1242     UV ord
1243     CODE:
1244         RETVAL = isALNUM(ord);
1245     OUTPUT:
1246         RETVAL
1247
1248 bool
1249 isALNUM_A(ord)
1250     UV ord
1251     CODE:
1252         RETVAL = isALNUM_A(ord);
1253     OUTPUT:
1254         RETVAL
1255
1256 bool
1257 isDIGIT(ord)
1258     UV ord
1259     CODE:
1260         RETVAL = isDIGIT(ord);
1261     OUTPUT:
1262         RETVAL
1263
1264 bool
1265 isDIGIT_A(ord)
1266     UV ord
1267     CODE:
1268         RETVAL = isDIGIT_A(ord);
1269     OUTPUT:
1270         RETVAL
1271
1272 bool
1273 isOCTAL(ord)
1274     UV ord
1275     CODE:
1276         RETVAL = isOCTAL(ord);
1277     OUTPUT:
1278         RETVAL
1279
1280 bool
1281 isOCTAL_A(ord)
1282     UV ord
1283     CODE:
1284         RETVAL = isOCTAL_A(ord);
1285     OUTPUT:
1286         RETVAL
1287
1288 bool
1289 isIDFIRST(ord)
1290     UV ord
1291     CODE:
1292         RETVAL = isIDFIRST(ord);
1293     OUTPUT:
1294         RETVAL
1295
1296 bool
1297 isIDFIRST_A(ord)
1298     UV ord
1299     CODE:
1300         RETVAL = isIDFIRST_A(ord);
1301     OUTPUT:
1302         RETVAL
1303
1304 bool
1305 isIDCONT(ord)
1306     UV ord
1307     CODE:
1308         RETVAL = isIDCONT(ord);
1309     OUTPUT:
1310         RETVAL
1311
1312 bool
1313 isIDCONT_A(ord)
1314     UV ord
1315     CODE:
1316         RETVAL = isIDCONT_A(ord);
1317     OUTPUT:
1318         RETVAL
1319
1320 bool
1321 isSPACE(ord)
1322     UV ord
1323     CODE:
1324         RETVAL = isSPACE(ord);
1325     OUTPUT:
1326         RETVAL
1327
1328 bool
1329 isSPACE_A(ord)
1330     UV ord
1331     CODE:
1332         RETVAL = isSPACE_A(ord);
1333     OUTPUT:
1334         RETVAL
1335
1336 bool
1337 isASCII(ord)
1338     UV ord
1339     CODE:
1340         RETVAL = isASCII(ord);
1341     OUTPUT:
1342         RETVAL
1343
1344 bool
1345 isASCII_A(ord)
1346     UV ord
1347     CODE:
1348         RETVAL = isASCII_A(ord);
1349     OUTPUT:
1350         RETVAL
1351
1352 bool
1353 isCNTRL(ord)
1354     UV ord
1355     CODE:
1356         RETVAL = isCNTRL(ord);
1357     OUTPUT:
1358         RETVAL
1359
1360 bool
1361 isCNTRL_A(ord)
1362     UV ord
1363     CODE:
1364         RETVAL = isCNTRL_A(ord);
1365     OUTPUT:
1366         RETVAL
1367
1368 bool
1369 isPRINT(ord)
1370     UV ord
1371     CODE:
1372         RETVAL = isPRINT(ord);
1373     OUTPUT:
1374         RETVAL
1375
1376 bool
1377 isPRINT_A(ord)
1378     UV ord
1379     CODE:
1380         RETVAL = isPRINT_A(ord);
1381     OUTPUT:
1382         RETVAL
1383
1384 bool
1385 isGRAPH(ord)
1386     UV ord
1387     CODE:
1388         RETVAL = isGRAPH(ord);
1389     OUTPUT:
1390         RETVAL
1391
1392 bool
1393 isGRAPH_A(ord)
1394     UV ord
1395     CODE:
1396         RETVAL = isGRAPH_A(ord);
1397     OUTPUT:
1398         RETVAL
1399
1400 bool
1401 isPUNCT(ord)
1402     UV ord
1403     CODE:
1404         RETVAL = isPUNCT(ord);
1405     OUTPUT:
1406         RETVAL
1407
1408 bool
1409 isPUNCT_A(ord)
1410     UV ord
1411     CODE:
1412         RETVAL = isPUNCT_A(ord);
1413     OUTPUT:
1414         RETVAL
1415
1416 bool
1417 isXDIGIT(ord)
1418     UV ord
1419     CODE:
1420         RETVAL = isXDIGIT(ord);
1421     OUTPUT:
1422         RETVAL
1423
1424 bool
1425 isXDIGIT_A(ord)
1426     UV ord
1427     CODE:
1428         RETVAL = isXDIGIT_A(ord);
1429     OUTPUT:
1430         RETVAL
1431
1432 bool
1433 isPSXSPC(ord)
1434     UV ord
1435     CODE:
1436         RETVAL = isPSXSPC(ord);
1437     OUTPUT:
1438         RETVAL
1439
1440 bool
1441 isPSXSPC_A(ord)
1442     UV ord
1443     CODE:
1444         RETVAL = isPSXSPC_A(ord);
1445     OUTPUT:
1446         RETVAL
1447
1448 bool
1449 isALPHANUMERIC_L1(ord)
1450     UV ord
1451     CODE:
1452         RETVAL = isALPHANUMERIC_L1(ord);
1453     OUTPUT:
1454         RETVAL
1455
1456 bool
1457 isALNUMC_L1(ord)
1458     UV ord
1459     CODE:
1460         RETVAL = isALNUMC_L1(ord);
1461     OUTPUT:
1462         RETVAL
1463
1464 bool
1465 isDIGIT_L1(ord)
1466     UV ord
1467     CODE:
1468         RETVAL = isDIGIT_L1(ord);
1469     OUTPUT:
1470         RETVAL
1471
1472 bool
1473 isOCTAL_L1(ord)
1474     UV ord
1475     CODE:
1476         RETVAL = isOCTAL_L1(ord);
1477     OUTPUT:
1478         RETVAL
1479
1480 bool
1481 isIDFIRST_L1(ord)
1482     UV ord
1483     CODE:
1484         RETVAL = isIDFIRST_L1(ord);
1485     OUTPUT:
1486         RETVAL
1487
1488 bool
1489 isIDCONT_L1(ord)
1490     UV ord
1491     CODE:
1492         RETVAL = isIDCONT_L1(ord);
1493     OUTPUT:
1494         RETVAL
1495
1496 bool
1497 isSPACE_L1(ord)
1498     UV ord
1499     CODE:
1500         RETVAL = isSPACE_L1(ord);
1501     OUTPUT:
1502         RETVAL
1503
1504 bool
1505 isASCII_L1(ord)
1506     UV ord
1507     CODE:
1508         RETVAL = isASCII_L1(ord);
1509     OUTPUT:
1510         RETVAL
1511
1512 bool
1513 isCNTRL_L1(ord)
1514     UV ord
1515     CODE:
1516         RETVAL = isCNTRL_L1(ord);
1517     OUTPUT:
1518         RETVAL
1519
1520 bool
1521 isPRINT_L1(ord)
1522     UV ord
1523     CODE:
1524         RETVAL = isPRINT_L1(ord);
1525     OUTPUT:
1526         RETVAL
1527
1528 bool
1529 isGRAPH_L1(ord)
1530     UV ord
1531     CODE:
1532         RETVAL = isGRAPH_L1(ord);
1533     OUTPUT:
1534         RETVAL
1535
1536 bool
1537 isPUNCT_L1(ord)
1538     UV ord
1539     CODE:
1540         RETVAL = isPUNCT_L1(ord);
1541     OUTPUT:
1542         RETVAL
1543
1544 bool
1545 isXDIGIT_L1(ord)
1546     UV ord
1547     CODE:
1548         RETVAL = isXDIGIT_L1(ord);
1549     OUTPUT:
1550         RETVAL
1551
1552 bool
1553 isPSXSPC_L1(ord)
1554     UV ord
1555     CODE:
1556         RETVAL = isPSXSPC_L1(ord);
1557     OUTPUT:
1558         RETVAL
1559
1560 #if { VERSION >= 5.006 }
1561
1562 bool
1563 isALPHA_utf8_safe(s, offset)
1564     unsigned char * s
1565     int offset
1566     CODE:
1567         RETVAL = isALPHA_utf8_safe(s, s + UTF8SKIP(s) + offset);
1568     OUTPUT:
1569         RETVAL
1570
1571 bool
1572 isALPHANUMERIC_utf8_safe(s, offset)
1573     unsigned char * s
1574     int offset
1575     CODE:
1576         RETVAL = isALPHANUMERIC_utf8_safe(s, s + UTF8SKIP(s) + offset);
1577     OUTPUT:
1578         RETVAL
1579
1580 bool
1581 isASCII_utf8_safe(s, offset)
1582     unsigned char * s
1583     int offset
1584     CODE:
1585         RETVAL = isASCII_utf8_safe(s, s + UTF8SKIP(s) + offset);
1586     OUTPUT:
1587         RETVAL
1588
1589 bool
1590 isBLANK_utf8_safe(s, offset)
1591     unsigned char * s
1592     int offset
1593     CODE:
1594         RETVAL = isBLANK_utf8_safe(s, s + UTF8SKIP(s) + offset);
1595     OUTPUT:
1596         RETVAL
1597
1598 bool
1599 isCNTRL_utf8_safe(s, offset)
1600     unsigned char * s
1601     int offset
1602     CODE:
1603         RETVAL = isCNTRL_utf8_safe(s, s + UTF8SKIP(s) + offset);
1604     OUTPUT:
1605         RETVAL
1606
1607 bool
1608 isDIGIT_utf8_safe(s, offset)
1609     unsigned char * s
1610     int offset
1611     CODE:
1612         RETVAL = isDIGIT_utf8_safe(s, s + UTF8SKIP(s) + offset);
1613     OUTPUT:
1614         RETVAL
1615
1616 bool
1617 isGRAPH_utf8_safe(s, offset)
1618     unsigned char * s
1619     int offset
1620     CODE:
1621         RETVAL = isGRAPH_utf8_safe(s, s + UTF8SKIP(s) + offset);
1622     OUTPUT:
1623         RETVAL
1624
1625 bool
1626 isIDCONT_utf8_safe(s, offset)
1627     unsigned char * s
1628     int offset
1629     CODE:
1630         RETVAL = isIDCONT_utf8_safe(s, s + UTF8SKIP(s) + offset);
1631     OUTPUT:
1632         RETVAL
1633
1634 bool
1635 isIDFIRST_utf8_safe(s, offset)
1636     unsigned char * s
1637     int offset
1638     CODE:
1639         RETVAL = isIDFIRST_utf8_safe(s, s + UTF8SKIP(s) + offset);
1640     OUTPUT:
1641         RETVAL
1642
1643 bool
1644 isLOWER_utf8_safe(s, offset)
1645     unsigned char * s
1646     int offset
1647     CODE:
1648         RETVAL = isLOWER_utf8_safe(s, s + UTF8SKIP(s) + offset);
1649     OUTPUT:
1650         RETVAL
1651
1652 bool
1653 isPRINT_utf8_safe(s, offset)
1654     unsigned char * s
1655     int offset
1656     CODE:
1657         RETVAL = isPRINT_utf8_safe(s, s + UTF8SKIP(s) + offset);
1658     OUTPUT:
1659         RETVAL
1660
1661 bool
1662 isPSXSPC_utf8_safe(s, offset)
1663     unsigned char * s
1664     int offset
1665     CODE:
1666         RETVAL = isPSXSPC_utf8_safe(s, s + UTF8SKIP(s) + offset);
1667     OUTPUT:
1668         RETVAL
1669
1670 bool
1671 isPUNCT_utf8_safe(s, offset)
1672     unsigned char * s
1673     int offset
1674     CODE:
1675         RETVAL = isPUNCT_utf8_safe(s, s + UTF8SKIP(s) + offset);
1676     OUTPUT:
1677         RETVAL
1678
1679 bool
1680 isSPACE_utf8_safe(s, offset)
1681     unsigned char * s
1682     int offset
1683     CODE:
1684         RETVAL = isSPACE_utf8_safe(s, s + UTF8SKIP(s) + offset);
1685     OUTPUT:
1686         RETVAL
1687
1688 bool
1689 isUPPER_utf8_safe(s, offset)
1690     unsigned char * s
1691     int offset
1692     CODE:
1693         RETVAL = isUPPER_utf8_safe(s, s + UTF8SKIP(s) + offset);
1694     OUTPUT:
1695         RETVAL
1696
1697 bool
1698 isWORDCHAR_utf8_safe(s, offset)
1699     unsigned char * s
1700     int offset
1701     CODE:
1702         RETVAL = isWORDCHAR_utf8_safe(s, s + UTF8SKIP(s) + offset);
1703     OUTPUT:
1704         RETVAL
1705
1706 bool
1707 isXDIGIT_utf8_safe(s, offset)
1708     unsigned char * s
1709     int offset
1710     CODE:
1711         RETVAL = isXDIGIT_utf8_safe(s, s + UTF8SKIP(s) + offset);
1712     OUTPUT:
1713         RETVAL
1714
1715 #endif
1716
1717 UV
1718 LATIN1_TO_NATIVE(cp)
1719         UV cp
1720         CODE:
1721                 if (cp > 255) RETVAL= cp;
1722                 else RETVAL= LATIN1_TO_NATIVE(cp);
1723         OUTPUT:
1724                 RETVAL
1725
1726 UV
1727 NATIVE_TO_LATIN1(cp)
1728         UV cp
1729         CODE:
1730                 RETVAL= NATIVE_TO_LATIN1(cp);
1731         OUTPUT:
1732                 RETVAL
1733
1734 STRLEN
1735 av_tindex(av)
1736         SV *av
1737         CODE:
1738                 RETVAL = av_tindex((AV*)SvRV(av));
1739         OUTPUT:
1740                 RETVAL
1741
1742 STRLEN
1743 av_top_index(av)
1744         SV *av
1745         CODE:
1746                 RETVAL = av_top_index((AV*)SvRV(av));
1747         OUTPUT:
1748                 RETVAL
1749
1750 =tests plan => 17678
1751
1752 use vars qw($my_sv @my_av %my_hv);
1753
1754 ok(&Devel::PPPort::boolSV(1));
1755 ok(!&Devel::PPPort::boolSV(0));
1756
1757 $_ = "Fred";
1758 ok(&Devel::PPPort::DEFSV(), "Fred");
1759 ok(&Devel::PPPort::UNDERBAR(), "Fred");
1760
1761 if ("$]" >= 5.009002 && "$]" < 5.023 && "$]" < 5.023004) {
1762   eval q{
1763     no warnings "deprecated";
1764     no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
1765     my $_ = "Tony";
1766     ok(&Devel::PPPort::DEFSV(), "Fred");
1767     ok(&Devel::PPPort::UNDERBAR(), "Tony");
1768   };
1769 }
1770 else {
1771   ok(1);
1772   ok(1);
1773 }
1774
1775 my @r = &Devel::PPPort::DEFSV_modify();
1776
1777 ok(@r == 3);
1778 ok($r[0], 'Fred');
1779 ok($r[1], 'DEFSV');
1780 ok($r[2], 'Fred');
1781
1782 ok(&Devel::PPPort::DEFSV(), "Fred");
1783
1784 eval { 1 };
1785 ok(!&Devel::PPPort::ERRSV());
1786 eval { cannot_call_this_one() };
1787 ok(&Devel::PPPort::ERRSV());
1788
1789 ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
1790 ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
1791 ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
1792
1793 $my_sv = 1;
1794 ok(&Devel::PPPort::get_sv('my_sv', 0));
1795 ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
1796 ok(&Devel::PPPort::get_sv('not_my_sv', 1));
1797
1798 @my_av = (1);
1799 ok(&Devel::PPPort::get_av('my_av', 0));
1800 ok(!&Devel::PPPort::get_av('not_my_av', 0));
1801 ok(&Devel::PPPort::get_av('not_my_av', 1));
1802
1803 %my_hv = (a=>1);
1804 ok(&Devel::PPPort::get_hv('my_hv', 0));
1805 ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
1806 ok(&Devel::PPPort::get_hv('not_my_hv', 1));
1807
1808 sub my_cv { 1 };
1809 ok(&Devel::PPPort::get_cv('my_cv', 0));
1810 ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
1811 ok(&Devel::PPPort::get_cv('not_my_cv', 1));
1812
1813 ok(Devel::PPPort::dXSTARG(42), 43);
1814 ok(Devel::PPPort::dAXMARK(4711), 4710);
1815
1816 ok(Devel::PPPort::prepush(), 42);
1817
1818 ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
1819 ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
1820
1821 ok(Devel::PPPort::PERL_ABS(42), 42);
1822 ok(Devel::PPPort::PERL_ABS(-13), 13);
1823
1824 ok(Devel::PPPort::SVf(42), "$]" >= 5.004 ? '[42]' : '42');
1825 ok(Devel::PPPort::SVf('abc'), "$]" >= 5.004 ? '[abc]' : 'abc');
1826
1827 ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
1828
1829 ok(&Devel::PPPort::ptrtests(), 63);
1830
1831 ok(&Devel::PPPort::OpSIBLING_tests(), 0);
1832
1833 if ("$]" >= 5.009000) {
1834   eval q{
1835     ok(&Devel::PPPort::check_HeUTF8("hello"), "norm");
1836     ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
1837   };
1838 } else {
1839   ok(1, 1);
1840   ok(1, 1);
1841 }
1842
1843 @r = &Devel::PPPort::check_c_array();
1844 ok($r[0], 4);
1845 ok($r[1], "13");
1846
1847 ok(!Devel::PPPort::SvRXOK(""));
1848 ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
1849
1850 if ("$]" < 5.005) {
1851         skip 'no qr// objects in this perl', 0;
1852         skip 'no qr// objects in this perl', 0;
1853 } else {
1854         my $qr = eval 'qr/./';
1855         ok(Devel::PPPort::SvRXOK($qr));
1856         ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise"));
1857 }
1858
1859 ok( Devel::PPPort::NATIVE_TO_LATIN1(0xB6) == 0xB6);
1860 ok( Devel::PPPort::NATIVE_TO_LATIN1(0x1) == 0x1);
1861 ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("A")) == 0x41);
1862 ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("0")) == 0x30);
1863
1864 ok( Devel::PPPort::LATIN1_TO_NATIVE(0xB6) == 0xB6);
1865 if (ord("A") == 65) {
1866     ok( Devel::PPPort::LATIN1_TO_NATIVE(0x41) == 0x41);
1867     ok( Devel::PPPort::LATIN1_TO_NATIVE(0x30) == 0x30);
1868 }
1869 else {
1870     ok( Devel::PPPort::LATIN1_TO_NATIVE(0x41) == 0xC1);
1871     ok( Devel::PPPort::LATIN1_TO_NATIVE(0x30) == 0xF0);
1872 }
1873
1874 ok(  Devel::PPPort::isALNUMC_L1(ord("5")));
1875 ok(  Devel::PPPort::isALNUMC_L1(0xFC));
1876 ok(! Devel::PPPort::isALNUMC_L1(0xB6));
1877
1878 ok(  Devel::PPPort::isOCTAL(ord("7")));
1879 ok(! Devel::PPPort::isOCTAL(ord("8")));
1880
1881 ok(  Devel::PPPort::isOCTAL_A(ord("0")));
1882 ok(! Devel::PPPort::isOCTAL_A(ord("9")));
1883
1884 ok(  Devel::PPPort::isOCTAL_L1(ord("2")));
1885 ok(! Devel::PPPort::isOCTAL_L1(ord("8")));
1886
1887 # For the other properties, we test every code point from 0.255, and a
1888 # smattering of higher ones.  First populate a hash with keys like '65:ALPHA'
1889 # to indicate that the code point there is alphabetic
1890 my $i;
1891 my %types;
1892 for $i (0x41..0x5A, 0x61..0x7A, 0xAA, 0xB5, 0xBA, 0xC0..0xD6, 0xD8..0xF6,
1893         0xF8..0x101)
1894 {
1895     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1896     $types{"$native:ALPHA"} = 1;
1897     $types{"$native:ALPHANUMERIC"} = 1;
1898     $types{"$native:IDFIRST"} = 1;
1899     $types{"$native:IDCONT"} = 1;
1900     $types{"$native:PRINT"} = 1;
1901     $types{"$native:WORDCHAR"} = 1;
1902 }
1903 for $i (0x30..0x39, 0x660, 0xFF19) {
1904     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1905     $types{"$native:ALPHANUMERIC"} = 1;
1906     $types{"$native:DIGIT"} = 1;
1907     $types{"$native:IDCONT"} = 1;
1908     $types{"$native:WORDCHAR"} = 1;
1909     $types{"$native:GRAPH"} = 1;
1910     $types{"$native:PRINT"} = 1;
1911     $types{"$native:XDIGIT"} = 1 if $i < 255 || ($i >= 0xFF10 && $i <= 0xFF19);
1912 }
1913
1914 for $i (0..0x7F) {
1915     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1916     $types{"$native:ASCII"} = 1;
1917 }
1918 for $i (0..0x1f, 0x7F..0x9F) {
1919     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1920     $types{"$native:CNTRL"} = 1;
1921 }
1922 for $i (0x21..0x7E, 0xA1..0x101, 0x660) {
1923     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1924     $types{"$native:GRAPH"} = 1;
1925     $types{"$native:PRINT"} = 1;
1926 }
1927 for $i (0x09, 0x20, 0xA0) {
1928     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1929     $types{"$native:BLANK"} = 1;
1930     $types{"$native:SPACE"} = 1;
1931     $types{"$native:PSXSPC"} = 1;
1932     $types{"$native:PRINT"} = 1 if $i > 0x09;
1933 }
1934 for $i (0x09..0x0D, 0x85, 0x2029) {
1935     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1936     $types{"$native:SPACE"} = 1;
1937     $types{"$native:PSXSPC"} = 1;
1938 }
1939 for $i (0x41..0x5A, 0xC0..0xD6, 0xD8..0xDE, 0x100) {
1940     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1941     $types{"$native:UPPER"} = 1;
1942     $types{"$native:XDIGIT"} = 1 if $i < 0x47;
1943 }
1944 for $i (0x61..0x7A, 0xAA, 0xB5, 0xBA, 0xDF..0xF6, 0xF8..0xFF, 0x101) {
1945     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1946     $types{"$native:LOWER"} = 1;
1947     $types{"$native:XDIGIT"} = 1 if $i < 0x67;
1948 }
1949 for $i (0x21..0x2F, 0x3A..0x40, 0x5B..0x60, 0x7B..0x7E, 0xB6, 0xA1, 0xA7, 0xAB,
1950         0xB7, 0xBB, 0xBF, 0x5BE)
1951 {
1952     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1953     $types{"$native:PUNCT"} = 1;
1954     $types{"$native:GRAPH"} = 1;
1955     $types{"$native:PRINT"} = 1;
1956 }
1957
1958 $i = ord('_');
1959 $types{"$i:WORDCHAR"} = 1;
1960 $types{"$i:IDFIRST"} = 1;
1961 $types{"$i:IDCONT"} = 1;
1962
1963 # Now find all the unique code points included above.
1964 my %code_points_to_test;
1965 my $key;
1966 for $key (keys %types) {
1967     $key =~ s/:.*//;
1968     $code_points_to_test{$key} = 1;
1969 }
1970
1971 # And test each one
1972 for $i (sort { $a <=> $b } keys %code_points_to_test) {
1973     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
1974     my $hex = sprintf("0x%02X", $native);
1975
1976     # And for each code point test each of the classes
1977     my $class;
1978     for $class (qw(ALPHA ALPHANUMERIC ASCII BLANK CNTRL DIGIT GRAPH IDCONT
1979                    IDFIRST LOWER PRINT PSXSPC PUNCT SPACE UPPER WORDCHAR
1980                    XDIGIT))
1981     {
1982         if ($i < 256) {  # For the ones that can fit in a byte, test each of
1983                          #three macros.
1984             my $suffix;
1985             for $suffix ("", "_A", "_L1") {
1986                 my $should_be = ($i > 0x7F && $suffix ne "_L1")
1987                                 ? 0     # Fail on non-ASCII unless L1
1988                                 : ($types{"$native:$class"} || 0);
1989                 my $eval_string = "Devel::PPPort::is${class}$suffix($hex)";
1990                 my $is = eval $eval_string || 0;
1991                 die "eval 'For $i: $eval_string' gave $@" if $@;
1992                 ok($is, $should_be, "'$eval_string'");
1993             }
1994         }
1995
1996         # For all code points, test the '_utf8' macros
1997         if ("$]" < 5.006) {
1998             skip("No UTF-8 on this perl", 0);
1999             if ($i > 255) {
2000                 skip("No UTF-8 on this perl", 0);
2001             }
2002         }
2003         else {
2004             my $utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($i);
2005             if ("$]" < 5.007 && $native > 255) {
2006                 skip("Perls earlier than 5.7 give wrong answers for above Latin1 code points", 0);
2007             }
2008             elsif ("$]" <= 5.011003 && $native == 0x2029 && ($class eq 'PRINT' || $class eq 'GRAPH')) {
2009                 skip("Perls earlier than 5.11.3 considered high space characters as isPRINT and isGRAPH", 0);
2010             }
2011             else {
2012
2013                 my $should_be = $types{"$native:$class"} || 0;
2014                 my $eval_string = "Devel::PPPort::is${class}_utf8_safe(\"$utf8\", 0)";
2015                 my $is = eval $eval_string || 0;
2016                 die "eval 'For $i, $eval_string' gave $@" if $@;
2017                 ok($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
2018             }
2019
2020             # And for the high code points, test that a too short malformation (the
2021             # -1) causes it to fail
2022             if ($i > 255) {
2023                 if ("$]" >= 5.025009) {
2024                     skip("Prints an annoying error message that khw doesn't know how to easily suppress", 0);
2025                 }
2026                 else {
2027                     my $eval_string = "Devel::PPPort::is${class}_utf8_safe(\"$utf8\", -1)";
2028                     my $is = eval "no warnings; $eval_string" || 0;
2029                     die "eval '$eval_string' gave $@" if $@;
2030                     ok($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
2031                 }
2032             }
2033         }
2034     }
2035 }
2036
2037 ok(&Devel::PPPort::av_top_index([1,2,3]), 2);
2038 ok(&Devel::PPPort::av_tindex([1,2,3,4]), 3);