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