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