dist/Devel-PPPort/parts/inc/misc

   1 ################################################################################
   2 ##
   3 ##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
   4 ##  Version 2.x, Copyright (C) 2001, Paul Marquess.
   5 ##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
   6 ##
   7 ##  This program is free software; you can redistribute it and/or
   8 ##  modify it under the same terms as Perl itself.
   9 ##
  10 ################################################################################
  11
  12 =provides
  13
  14 __UNDEFINED__
  15 END_EXTERN_C
  16 EXTERN_C
  17 INT2PTR
  18 MUTABLE_PTR
  19 NVTYPE
  20 PERLIO_FUNCS_CAST
  21 PERLIO_FUNCS_DECL
  22 PERL_UNUSED_ARG
  23 PERL_UNUSED_CONTEXT
  24 PERL_UNUSED_DECL
  25 PERL_UNUSED_RESULT
  26 PERL_UNUSED_VAR
  27 PERL_USE_GCC_BRACE_GROUPS
  28 PTR2ul
  29 PTRV
  30 START_EXTERN_C
  31 STMT_END
  32 STMT_START
  33 SvRX
  34 WIDEST_UTYPE
  35 XSRETURN
  36
  37 =implementation
  38
  39 __UNDEFINED__ cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
  40 __UNDEFINED__ OpHAS_SIBLING(o)      (cBOOL((o)->op_sibling))
  41 __UNDEFINED__ OpSIBLING(o)          (0 + (o)->op_sibling)
  42 __UNDEFINED__ OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
  43 __UNDEFINED__ OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
  44 __UNDEFINED__ OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
  45 __UNDEFINED__ HEf_SVKEY   -2
  46
  47 #if defined(DEBUGGING) && !defined(__COVERITY__)
  48 __UNDEFINED__ __ASSERT_(statement)  assert(statement),
  49 #else
  50 __UNDEFINED__ __ASSERT_(statement)
  51 #endif
  52
  53 /* These could become provided when they become part of the public API */
  54 __UNDEF_NOT_PROVIDED__ withinCOUNT(c, l, n)                                 \
  55    (((WIDEST_UTYPE) (((c)) - ((l) | 0))) <= (((WIDEST_UTYPE) ((n) | 0))))
  56 __UNDEF_NOT_PROVIDED__ inRANGE(c, l, u)                                    \
  57    (  (sizeof(c) == sizeof(U8))  ? withinCOUNT(((U8)  (c)), (l), ((u) - (l)))  \
  58     : (sizeof(c) == sizeof(U16)) ? withinCOUNT(((U16) (c)), (l), ((u) - (l)))  \
  59     : (sizeof(c) == sizeof(U32)) ? withinCOUNT(((U32) (c)), (l), ((u) - (l)))  \
  60     : (withinCOUNT(((WIDEST_UTYPE) (c)), (l), ((u) - (l)))))
  61
  62 /* Create the macro for "is'macro'_utf8_safe(s, e)".  For code points below
  63  * 256, it calls the equivalent _L1 macro by converting the UTF-8 to code
  64  * point.  That is so that it can automatically get the bug fixes done in this
  65  * file. */
  66 #define D_PPP_IS_GENERIC_UTF8_SAFE(s, e, macro)                             \
  67    (((e) - (s)) <= 0                                                        \
  68      ? 0                                                                    \
  69      : UTF8_IS_INVARIANT((s)[0])                                            \
  70        ? is ## macro ## _L1((s)[0])                                         \
  71        : (((e) - (s)) < UTF8SKIP(s))                                        \
  72           ? 0                                                               \
  73           : UTF8_IS_DOWNGRADEABLE_START((s)[0])                             \
  74               /* The cast in the line below is only to silence warnings */  \
  75             ? is ## macro ## _L1((WIDEST_UTYPE) LATIN1_TO_NATIVE(           \
  76                                   UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \
  77                                                      & UTF_START_MASK(2),   \
  78                                                   (s)[1])))                 \
  79             : is ## macro ## _utf8(s))
  80
  81 __UNDEFINED__ SvRX(rv) (SvROK((rv)) ? (SvMAGICAL(SvRV((rv))) ? (mg_find(SvRV((rv)), PERL_MAGIC_qr) ? mg_find(SvRV((rv)), PERL_MAGIC_qr)->mg_obj : NULL) : NULL) : NULL)
  82 __UNDEFINED__ SvRXOK(sv) (!!SvRX(sv))
  83
  84 #ifndef PERL_UNUSED_DECL
  85 #  ifdef HASATTRIBUTE
  86 #    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
  87 #      define PERL_UNUSED_DECL
  88 #    else
  89 #      define PERL_UNUSED_DECL __attribute__((unused))
  90 #    endif
  91 #  else
  92 #    define PERL_UNUSED_DECL
  93 #  endif
  94 #endif
  95
  96 #ifndef PERL_UNUSED_ARG
  97 #  if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
  98 #    include <note.h>
  99 #    define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
 100 #  else
 101 #    define PERL_UNUSED_ARG(x) ((void)x)
 102 #  endif
 103 #endif
 104
 105 #ifndef PERL_UNUSED_VAR
 106 #  define PERL_UNUSED_VAR(x) ((void)x)
 107 #endif
 108
 109 #ifndef PERL_UNUSED_CONTEXT
 110 #  ifdef USE_ITHREADS
 111 #    define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
 112 #  else
 113 #    define PERL_UNUSED_CONTEXT
 114 #  endif
 115 #endif
 116
 117 #ifndef PERL_UNUSED_RESULT
 118 #  if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
 119 #    define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
 120 #  else
 121 #    define PERL_UNUSED_RESULT(v) ((void)(v))
 122 #  endif
 123 #endif
 124
 125 __UNDEFINED__  NOOP          /*EMPTY*/(void)0
 126 __UNDEFINED__  dNOOP         extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
 127
 128 #ifndef NVTYPE
 129 #  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
 130 #    define NVTYPE long double
 131 #  else
 132 #    define NVTYPE double
 133 #  endif
 134 typedef NVTYPE NV;
 135 #endif
 136
 137 #ifndef INT2PTR
 138 #  if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
 139 #    define PTRV                  UV
 140 #    define INT2PTR(any,d)        (any)(d)
 141 #  else
 142 #    if PTRSIZE == LONGSIZE
 143 #      define PTRV                unsigned long
 144 #    else
 145 #      define PTRV                unsigned
 146 #    endif
 147 #    define INT2PTR(any,d)        (any)(PTRV)(d)
 148 #  endif
 149 #endif
 150
 151 #ifndef PTR2ul
 152 #  if PTRSIZE == LONGSIZE
 153 #    define PTR2ul(p)     (unsigned long)(p)
 154 #  else
 155 #    define PTR2ul(p)     INT2PTR(unsigned long,p)
 156 #  endif
 157 #endif
 158
 159 __UNDEFINED__  PTR2nat(p)      (PTRV)(p)
 160 __UNDEFINED__  NUM2PTR(any,d)  (any)PTR2nat(d)
 161 __UNDEFINED__  PTR2IV(p)       INT2PTR(IV,p)
 162 __UNDEFINED__  PTR2UV(p)       INT2PTR(UV,p)
 163 __UNDEFINED__  PTR2NV(p)       NUM2PTR(NV,p)
 164
 165 #undef START_EXTERN_C
 166 #undef END_EXTERN_C
 167 #undef EXTERN_C
 168 #ifdef __cplusplus
 169 #  define START_EXTERN_C extern "C" {
 170 #  define END_EXTERN_C }
 171 #  define EXTERN_C extern "C"
 172 #else
 173 #  define START_EXTERN_C
 174 #  define END_EXTERN_C
 175 #  define EXTERN_C extern
 176 #endif
 177
 178 #if { VERSION < 5.004 } || defined(PERL_GCC_PEDANTIC)
 179 #  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
 180 __UNDEF_NOT_PROVIDED__  PERL_GCC_BRACE_GROUPS_FORBIDDEN
 181 #  endif
 182 #endif
 183
 184 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
 185 #  ifndef PERL_USE_GCC_BRACE_GROUPS
 186 #    define PERL_USE_GCC_BRACE_GROUPS
 187 #  endif
 188 #endif
 189
 190 #undef STMT_START
 191 #undef STMT_END
 192 #ifdef PERL_USE_GCC_BRACE_GROUPS
 193 #  define STMT_START    (void)( /* gcc supports ``({ STATEMENTS; })'' */
 194 #  define STMT_END      )
 195 #else
 196 #  if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
 197 #    define STMT_START  if (1)
 198 #    define STMT_END    else (void)0
 199 #  else
 200 #    define STMT_START  do
 201 #    define STMT_END    while (0)
 202 #  endif
 203 #endif
 204
 205 __UNDEFINED__  boolSV(b)    ((b) ? &PL_sv_yes : &PL_sv_no)
 206
 207 /* DEFSV appears first in 5.004_56 */
 208 __UNDEFINED__  DEFSV        GvSV(PL_defgv)
 209 __UNDEFINED__  SAVE_DEFSV   SAVESPTR(GvSV(PL_defgv))
 210 __UNDEFINED__  DEFSV_set(sv) (DEFSV = (sv))
 211
 212 /* Older perls (<=5.003) lack AvFILLp */
 213 __UNDEFINED__  AvFILLp      AvFILL
 214
 215 __UNDEFINED__  av_tindex    AvFILL
 216 __UNDEFINED__  av_top_index AvFILL
 217
 218 __UNDEFINED__  ERRSV        get_sv("@",FALSE)
 219
 220 /* Hint: gv_stashpvn
 221  * This function's backport doesn't support the length parameter, but
 222  * rather ignores it. Portability can only be ensured if the length
 223  * parameter is used for speed reasons, but the length can always be
 224  * correctly computed from the string argument.
 225  */
 226
 227 __UNDEFINED__  gv_stashpvn(str,len,create)  gv_stashpv(str,create)
 228
 229 /* Replace: 1 */
 230 __UNDEFINED__  get_cv          perl_get_cv
 231 __UNDEFINED__  get_sv          perl_get_sv
 232 __UNDEFINED__  get_av          perl_get_av
 233 __UNDEFINED__  get_hv          perl_get_hv
 234 /* Replace: 0 */
 235
 236 __UNDEFINED__  dUNDERBAR       dNOOP
 237 __UNDEFINED__  UNDERBAR        DEFSV
 238
 239 __UNDEFINED__  dAX             I32 ax = MARK - PL_stack_base + 1
 240 __UNDEFINED__  dITEMS          I32 items = SP - MARK
 241
 242 __UNDEFINED__  dXSTARG         SV * targ = sv_newmortal()
 243
 244 __UNDEFINED__  dAXMARK         I32 ax = POPMARK; \
 245                                register SV ** const mark = PL_stack_base + ax++
 246
 247
 248 __UNDEFINED__  XSprePUSH       (sp = PL_stack_base + ax - 1)
 249
 250 #if { VERSION < 5.005 }
 251 #  undef XSRETURN
 252 #  define XSRETURN(off)                                   \
 253       STMT_START {                                        \
 254           PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
 255           return;                                         \
 256       } STMT_END
 257 #endif
 258
 259 __UNDEFINED__  XSPROTO(name)   void name(pTHX_ CV* cv)
 260 __UNDEFINED__  SVfARG(p)       ((void*)(p))
 261
 262 __UNDEFINED__  PERL_ABS(x)     ((x) < 0 ? -(x) : (x))
 263
 264 __UNDEFINED__  dVAR            dNOOP
 265
 266 __UNDEFINED__  SVf             "_"
 267
 268 __UNDEFINED__  CPERLscope(x)   x
 269
 270 __UNDEFINED__  PERL_HASH(hash,str,len) \
 271      STMT_START { \
 272         const char *s_PeRlHaSh = str; \
 273         I32 i_PeRlHaSh = len; \
 274         U32 hash_PeRlHaSh = 0; \
 275         while (i_PeRlHaSh--) \
 276             hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
 277         (hash) = hash_PeRlHaSh; \
 278     } STMT_END
 279
 280 #ifndef PERLIO_FUNCS_DECL
 281 # ifdef PERLIO_FUNCS_CONST
 282 #  define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
 283 #  define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
 284 # else
 285 #  define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
 286 #  define PERLIO_FUNCS_CAST(funcs) (funcs)
 287 # endif
 288 #endif
 289
 290 /* provide these typedefs for older perls */
 291 #if { VERSION < 5.9.3 }
 292
 293 # ifdef ARGSproto
 294 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
 295 # else
 296 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
 297 # endif
 298
 299 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
 300
 301 #endif
 302
 303 #ifndef WIDEST_UTYPE
 304 # ifdef QUADKIND
 305 #  ifdef U64TYPE
 306 #   define WIDEST_UTYPE U64TYPE
 307 #  else
 308 #   define WIDEST_UTYPE Quad_t
 309 #  endif
 310 # else
 311 #  define WIDEST_UTYPE U32
 312 # endif
 313 #endif
 314
 315 /* On versions without NATIVE_TO_ASCII, only ASCII is supported */
 316 #if defined(EBCDIC) && defined(NATIVE_TO_ASCI)
 317 __UNDEFINED__ NATIVE_TO_LATIN1(c) NATIVE_TO_ASCII(c)
 318 __UNDEFINED__ LATIN1_TO_NATIVE(c) ASCII_TO_NATIVE(c)
 319 __UNDEFINED__ NATIVE_TO_UNI(c) ((c) > 255 ? (c) : NATIVE_TO_LATIN1(c))
 320 __UNDEFINED__ UNI_TO_NATIVE(c) ((c) > 255 ? (c) : LATIN1_TO_NATIVE(c))
 321 #else
 322 __UNDEFINED__ NATIVE_TO_LATIN1(c) (c)
 323 __UNDEFINED__ LATIN1_TO_NATIVE(c) (c)
 324 __UNDEFINED__ NATIVE_TO_UNI(c) (c)
 325 __UNDEFINED__ UNI_TO_NATIVE(c) (c)
 326 #endif
 327
 328 /* Warning: LATIN1_TO_NATIVE, NATIVE_TO_LATIN1 NATIVE_TO_UNI UNI_TO_NATIVE
 329    EBCDIC is not supported on versions earlier than 5.7.1
 330  */
 331
 332 /* The meaning of this changed; use the modern version */
 333 #undef isPSXSPC
 334 #undef isPSXSPC_A
 335 #undef isPSXSPC_L1
 336
 337 /* Hint: isPSXSPC, isPSXSPC_A, isPSXSPC_L1, isPSXSPC_utf8_safe
 338     This is equivalent to the corresponding isSPACE-type macro.  On perls
 339     before 5.18, this matched a vertical tab and SPACE didn't.  But the
 340     ppport.h SPACE version does match VT in all perl releases.  Since VT's are
 341     extremely rarely found in real-life files, this difference effectively
 342     doesn't matter */
 343
 344 /* Hint: isSPACE, isSPACE_A, isSPACE_L1, isSPACE_utf8_safe
 345     Until Perl 5.18, this did not match the vertical tab (VT).  The ppport.h
 346     version does match it in all perl releases. Since VT's are extremely rarely
 347     found in real-life files, this difference effectively doesn't matter */
 348
 349 #ifdef EBCDIC
 350
 351 /* This is the first version where these macros are fully correct on EBCDIC
 352  * platforms.  Relying on * the C library functions, as earlier releases did,
 353  * causes problems with * locales */
 354 # if { VERSION < 5.22.0 }
 355 #  undef isALNUM
 356 #  undef isALNUM_A
 357 #  undef isALNUM_L1
 358 #  undef isALNUMC
 359 #  undef isALNUMC_A
 360 #  undef isALNUMC_L1
 361 #  undef isALPHA
 362 #  undef isALPHA_A
 363 #  undef isALPHA_L1
 364 #  undef isALPHANUMERIC
 365 #  undef isALPHANUMERIC_A
 366 #  undef isALPHANUMERIC_L1
 367 #  undef isASCII
 368 #  undef isASCII_A
 369 #  undef isASCII_L1
 370 #  undef isBLANK
 371 #  undef isBLANK_A
 372 #  undef isBLANK_L1
 373 #  undef isCNTRL
 374 #  undef isCNTRL_A
 375 #  undef isCNTRL_L1
 376 #  undef isDIGIT
 377 #  undef isDIGIT_A
 378 #  undef isDIGIT_L1
 379 #  undef isGRAPH
 380 #  undef isGRAPH_A
 381 #  undef isGRAPH_L1
 382 #  undef isIDCONT
 383 #  undef isIDCONT_A
 384 #  undef isIDCONT_L1
 385 #  undef isIDFIRST
 386 #  undef isIDFIRST_A
 387 #  undef isIDFIRST_L1
 388 #  undef isLOWER
 389 #  undef isLOWER_A
 390 #  undef isLOWER_L1
 391 #  undef isOCTAL
 392 #  undef isOCTAL_A
 393 #  undef isOCTAL_L1
 394 #  undef isPRINT
 395 #  undef isPRINT_A
 396 #  undef isPRINT_L1
 397 #  undef isPUNCT
 398 #  undef isPUNCT_A
 399 #  undef isPUNCT_L1
 400 #  undef isSPACE
 401 #  undef isSPACE_A
 402 #  undef isSPACE_L1
 403 #  undef isUPPER
 404 #  undef isUPPER_A
 405 #  undef isUPPER_L1
 406 #  undef isWORDCHAR
 407 #  undef isWORDCHAR_A
 408 #  undef isWORDCHAR_L1
 409 #  undef isXDIGIT
 410 #  undef isXDIGIT_A
 411 #  undef isXDIGIT_L1
 412 # endif
 413
 414 __UNDEFINED__ isASCII(c)    (isCNTRL(c) || isPRINT(c))
 415
 416         /* The below is accurate for all EBCDIC code pages supported by
 417          * all the versions of Perl overridden by this */
 418 __UNDEFINED__ isCNTRL(c)    (    (c) == '\0' || (c) == '\a' || (c) == '\b'      \
 419                              ||  (c) == '\f' || (c) == '\n' || (c) == '\r'      \
 420                              ||  (c) == '\t' || (c) == '\v'                     \
 421                              || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */      \
 422                              ||  (c) == 7    /* U+7F DEL */                     \
 423                              || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */       \
 424                                                       /* DLE, DC[1-3] */        \
 425                              ||  (c) == 0x18 /* U+18 CAN */                     \
 426                              ||  (c) == 0x19 /* U+19 EOM */                     \
 427                              || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */      \
 428                              ||  (c) == 0x26 /* U+17 ETB */                     \
 429                              ||  (c) == 0x27 /* U+1B ESC */                     \
 430                              ||  (c) == 0x2D /* U+05 ENQ */                     \
 431                              ||  (c) == 0x2E /* U+06 ACK */                     \
 432                              ||  (c) == 0x32 /* U+16 SYN */                     \
 433                              ||  (c) == 0x37 /* U+04 EOT */                     \
 434                              ||  (c) == 0x3C /* U+14 DC4 */                     \
 435                              ||  (c) == 0x3D /* U+15 NAK */                     \
 436                              ||  (c) == 0x3F /* U+1A SUB */                     \
 437                             )
 438
 439 #if '^' == 106    /* EBCDIC POSIX-BC */
 440 #  define D_PPP_OUTLIER_CONTROL 0x5F
 441 #else   /* EBCDIC 1047 037 */
 442 #  define D_PPP_OUTLIER_CONTROL 0xFF
 443 #endif
 444
 445 /* The controls are everything below blank, plus one outlier */
 446 __UNDEFINED__ isCNTRL_L1(c) ((WIDEST_UTYPE) (c) < ' '                           \
 447                           || (WIDEST_UTYPE) (c) == D_PPP_OUTLIER_CONTROL)
 448 /* The ordering of the tests in this and isUPPER are to exclude most characters
 449  * early */
 450 __UNDEFINED__ isLOWER(c)    (        (c) >= 'a' && (c) <= 'z'                   \
 451                              &&  (   (c) <= 'i'                                 \
 452                                  || ((c) >= 'j' && (c) <= 'r')                  \
 453                                  ||  (c) >= 's'))
 454 __UNDEFINED__ isUPPER(c)    (        (c) >= 'A' && (c) <= 'Z'                   \
 455                              && (    (c) <= 'I'                                 \
 456                                  || ((c) >= 'J' && (c) <= 'R')                  \
 457                                  ||  (c) >= 'S'))
 458
 459 #else   /* Above is EBCDIC; below is ASCII */
 460
 461 # if { VERSION < 5.4.0 }
 462 /* The implementation of these in older perl versions can give wrong results if
 463  * the C program locale is set to other than the C locale */
 464 #  undef isALNUM
 465 #  undef isALNUM_A
 466 #  undef isALPHA
 467 #  undef isALPHA_A
 468 #  undef isDIGIT
 469 #  undef isDIGIT_A
 470 #  undef isIDFIRST
 471 #  undef isIDFIRST_A
 472 #  undef isLOWER
 473 #  undef isLOWER_A
 474 #  undef isUPPER
 475 #  undef isUPPER_A
 476 # endif
 477
 478 #  if { VERSION == 5.7.0 } /* this perl made space GRAPH */
 479 #    undef isGRAPH
 480 #  endif
 481
 482 # if { VERSION < 5.8.0 } /* earlier perls omitted DEL */
 483 #  undef isCNTRL
 484 # endif
 485
 486 # if { VERSION < 5.10.0 }
 487 /* earlier perls included all of the isSPACE() characters, which is wrong. The
 488  * version provided by Devel::PPPort always overrides an existing buggy
 489  * version. */
 490 #  undef isPRINT
 491 #  undef isPRINT_A
 492 # endif
 493
 494 # if { VERSION < 5.14.0 }
 495 /* earlier perls always returned true if the parameter was a signed char */
 496 #  undef isASCII
 497 #  undef isASCII_A
 498 # endif
 499
 500 # if { VERSION < 5.17.8 } /* earlier perls didn't include PILCROW, SECTION SIGN */
 501 #  undef isPUNCT_L1
 502 # endif
 503
 504 # if { VERSION < 5.13.7 } /* khw didn't investigate why this failed */
 505 #  undef isALNUMC_L1
 506 #endif
 507
 508 # if { VERSION < 5.20.0 } /* earlier perls didn't include \v */
 509 #  undef isSPACE
 510 #  undef isSPACE_A
 511 #  undef isSPACE_L1
 512
 513 # endif
 514
 515 __UNDEFINED__ isASCII(c)        ((WIDEST_UTYPE) (c) <= 127)
 516 __UNDEFINED__ isCNTRL(c)        ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
 517 __UNDEFINED__ isCNTRL_L1(c)     (isCNTRL(c) || (   (WIDEST_UTYPE) (c) <= 0x9F  \
 518                                                 && (WIDEST_UTYPE) (c) >= 0x80))
 519 __UNDEFINED__ isLOWER(c)        ((c) >= 'a' && (c) <= 'z')
 520 __UNDEFINED__ isUPPER(c)        ((c) <= 'Z' && (c) >= 'A')
 521
 522 #endif /* Below are definitions common to EBCDIC and ASCII */
 523
 524 __UNDEFINED__ isASCII_L1(c)     isASCII(c)
 525 __UNDEFINED__ isALNUM(c)        isWORDCHAR(c)
 526 __UNDEFINED__ isALNUMC(c)       isALPHANUMERIC(c)
 527 __UNDEFINED__ isALNUMC_L1(c)    isALPHANUMERIC_L1(c)
 528 __UNDEFINED__ isALPHA(c)        (isUPPER(c) || isLOWER(c))
 529 __UNDEFINED__ isALPHA_L1(c)     (isUPPER_L1(c) || isLOWER_L1(c))
 530 __UNDEFINED__ isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c))
 531 __UNDEFINED__ isALPHANUMERIC_L1(c) (isALPHA_L1(c) || isDIGIT(c))
 532 __UNDEFINED__ isBLANK(c)        ((c) == ' ' || (c) == '\t')
 533 __UNDEFINED__ isBLANK_L1(c) (    isBLANK(c)                                    \
 534                              || (   (WIDEST_UTYPE) (c) < 256                   \
 535                                  && NATIVE_TO_LATIN1((U8) c) == 0xA0))
 536 __UNDEFINED__ isDIGIT(c)        ((c) <= '9' && (c) >= '0')
 537 __UNDEFINED__ isDIGIT_L1(c)     isDIGIT(c)
 538 __UNDEFINED__ isGRAPH(c)        (isWORDCHAR(c) || isPUNCT(c))
 539 __UNDEFINED__ isGRAPH_L1(c)     (   isPRINT_L1(c)                              \
 540                                  && (c) != ' '                                 \
 541                                  && NATIVE_TO_LATIN1((U8) c) != 0xA0)
 542 __UNDEFINED__ isIDCONT(c)       isWORDCHAR(c)
 543 __UNDEFINED__ isIDCONT_L1(c)    isWORDCHAR_L1(c)
 544 __UNDEFINED__ isIDFIRST(c)      (isALPHA(c) || (c) == '_')
 545 __UNDEFINED__ isIDFIRST_L1(c)   (isALPHA_L1(c) || (U8) (c) == '_')
 546 __UNDEFINED__ isLOWER_L1(c) (    isLOWER(c)                                    \
 547                              || (   (WIDEST_UTYPE) (c) < 256                   \
 548                                  && (  (   NATIVE_TO_LATIN1((U8) c) >= 0xDF    \
 549                                         && NATIVE_TO_LATIN1((U8) c) != 0xF7)   \
 550                                      || NATIVE_TO_LATIN1((U8) c) == 0xAA       \
 551                                      || NATIVE_TO_LATIN1((U8) c) == 0xBA       \
 552                                      || NATIVE_TO_LATIN1((U8) c) == 0xB5)))
 553 __UNDEFINED__ isOCTAL(c)        (((WIDEST_UTYPE)((c)) & ~7) == '0')
 554 __UNDEFINED__ isOCTAL_L1(c)     isOCTAL(c)
 555 __UNDEFINED__ isPRINT(c)        (isGRAPH(c) || (c) == ' ')
 556 __UNDEFINED__ isPRINT_L1(c)     ((WIDEST_UTYPE) (c) < 256 && ! isCNTRL_L1(c))
 557 __UNDEFINED__ isPSXSPC(c)       isSPACE(c)
 558 __UNDEFINED__ isPSXSPC_L1(c)    isSPACE_L1(c)
 559 __UNDEFINED__ isPUNCT(c)    (   (c) == '-' || (c) == '!' || (c) == '"'         \
 560                              || (c) == '#' || (c) == '$' || (c) == '%'         \
 561                              || (c) == '&' || (c) == '\'' || (c) == '('        \
 562                              || (c) == ')' || (c) == '*' || (c) == '+'         \
 563                              || (c) == ',' || (c) == '.' || (c) == '/'         \
 564                              || (c) == ':' || (c) == ';' || (c) == '<'         \
 565                              || (c) == '=' || (c) == '>' || (c) == '?'         \
 566                              || (c) == '@' || (c) == '[' || (c) == '\\'        \
 567                              || (c) == ']' || (c) == '^' || (c) == '_'         \
 568                              || (c) == '`' || (c) == '{' || (c) == '|'         \
 569                              || (c) == '}' || (c) == '~')
 570 __UNDEFINED__ isPUNCT_L1(c)  (    isPUNCT(c)                                   \
 571                               || (   (WIDEST_UTYPE) (c) < 256                  \
 572                                   && (   NATIVE_TO_LATIN1((U8) c) == 0xA1      \
 573                                       || NATIVE_TO_LATIN1((U8) c) == 0xA7      \
 574                                       || NATIVE_TO_LATIN1((U8) c) == 0xAB      \
 575                                       || NATIVE_TO_LATIN1((U8) c) == 0xB6      \
 576                                       || NATIVE_TO_LATIN1((U8) c) == 0xB7      \
 577                                       || NATIVE_TO_LATIN1((U8) c) == 0xBB      \
 578                                       || NATIVE_TO_LATIN1((U8) c) == 0xBF)))
 579 __UNDEFINED__ isSPACE(c)        (   isBLANK(c) || (c) == '\n' || (c) == '\r'   \
 580                                  || (c) == '\v' || (c) == '\f')
 581 __UNDEFINED__ isSPACE_L1(c) (    isSPACE(c)                                    \
 582                              || (   (WIDEST_UTYPE) (c) < 256                   \
 583                                  && (   NATIVE_TO_LATIN1((U8) c) == 0x85       \
 584                                      || NATIVE_TO_LATIN1((U8) c) == 0xA0)))
 585 __UNDEFINED__ isUPPER_L1(c) (   isUPPER(c)                                     \
 586                              || (   (WIDEST_UTYPE) (c) < 256                   \
 587                                  && (   NATIVE_TO_LATIN1((U8) c) >= 0xC0       \
 588                                      && NATIVE_TO_LATIN1((U8) c) <= 0xDE       \
 589                                      && NATIVE_TO_LATIN1((U8) c) != 0xD7)))
 590 __UNDEFINED__ isWORDCHAR(c)     (isALPHANUMERIC(c) || (c) == '_')
 591 __UNDEFINED__ isWORDCHAR_L1(c)  (isIDFIRST_L1(c) || isDIGIT(c))
 592 __UNDEFINED__ isXDIGIT(c)       (   isDIGIT(c)                                 \
 593                                  || ((c) >= 'a' && (c) <= 'f')                 \
 594                                  || ((c) >= 'A' && (c) <= 'F'))
 595 __UNDEFINED__ isXDIGIT_L1(c)    isXDIGIT(c)
 596
 597 __UNDEFINED__ isALNUM_A(c)         isALNUM(c)
 598 __UNDEFINED__ isALNUMC_A(c)        isALNUMC(c)
 599 __UNDEFINED__ isALPHA_A(c)         isALPHA(c)
 600 __UNDEFINED__ isALPHANUMERIC_A(c)  isALPHANUMERIC(c)
 601 __UNDEFINED__ isASCII_A(c)         isASCII(c)
 602 __UNDEFINED__ isBLANK_A(c)         isBLANK(c)
 603 __UNDEFINED__ isCNTRL_A(c)         isCNTRL(c)
 604 __UNDEFINED__ isDIGIT_A(c)         isDIGIT(c)
 605 __UNDEFINED__ isGRAPH_A(c)         isGRAPH(c)
 606 __UNDEFINED__ isIDCONT_A(c)        isIDCONT(c)
 607 __UNDEFINED__ isIDFIRST_A(c)       isIDFIRST(c)
 608 __UNDEFINED__ isLOWER_A(c)         isLOWER(c)
 609 __UNDEFINED__ isOCTAL_A(c)         isOCTAL(c)
 610 __UNDEFINED__ isPRINT_A(c)         isPRINT(c)
 611 __UNDEFINED__ isPSXSPC_A(c)        isPSXSPC(c)
 612 __UNDEFINED__ isPUNCT_A(c)         isPUNCT(c)
 613 __UNDEFINED__ isSPACE_A(c)         isSPACE(c)
 614 __UNDEFINED__ isUPPER_A(c)         isUPPER(c)
 615 __UNDEFINED__ isWORDCHAR_A(c)      isWORDCHAR(c)
 616 __UNDEFINED__ isXDIGIT_A(c)        isXDIGIT(c)
 617
 618 __UNDEFINED__ isASCII_utf8_safe(s,e)  (((e) - (s)) <= 0 ? 0 : isASCII(*(s)))
 619 __UNDEFINED__ isASCII_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 620                                    ? isASCII_L1(c) : 0)
 621
 622 #if { VERSION >= 5.006 }
 623
 624 __UNDEFINED__ isALPHA_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 625                                    ? isALPHA_L1(c) : is_uni_alpha((UV) (c)))
 626 __UNDEFINED__ isALPHANUMERIC_uvchr(c)  ((WIDEST_UTYPE) (c) < 256                 \
 627     ? isALPHANUMERIC_L1(c) : (is_uni_alpha((UV) (c)) || is_uni_digit((UV) (c))))
 628 #  ifdef is_uni_blank
 629 __UNDEFINED__ isBLANK_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 630                                    ? isBLANK_L1(c) : is_uni_blank((UV) (c)))
 631 #  else
 632 __UNDEFINED__ isBLANK_uvchr(c)  ((WIDEST_UTYPE) (c) < 256                   \
 633                                  ? isBLANK_L1(c)                            \
 634                                  : (   (UV) (c) == 0x1680 /* Unicode 3.0 */ \
 635                                     || inRANGE((UV) (c), 0x2000, 0x200A)    \
 636                                     || (UV) (c) == 0x202F  /* Unicode 3.0 */\
 637                                     || (UV) (c) == 0x205F  /* Unicode 3.2 */\
 638                                     || (UV) (c) == 0x3000))
 639 #  endif
 640 __UNDEFINED__ isCNTRL_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 641                                    ? isCNTRL_L1(c) : is_uni_cntrl((UV) (c)))
 642 __UNDEFINED__ isDIGIT_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 643                                    ? isDIGIT_L1(c) : is_uni_digit((UV) (c)))
 644 __UNDEFINED__ isGRAPH_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 645                                    ? isGRAPH_L1(c) : is_uni_graph((UV) (c)))
 646 __UNDEFINED__ isIDCONT_uvchr(c)    isWORDCHAR_uvchr(c)
 647 __UNDEFINED__ isIDFIRST_uvchr(c)  ((WIDEST_UTYPE) (c) < 256                 \
 648                                    ? isIDFIRST_L1(c) : is_uni_idfirst((UV) (c)))
 649 __UNDEFINED__ isLOWER_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 650                                    ? isLOWER_L1(c) : is_uni_lower((UV) (c)))
 651 __UNDEFINED__ isPRINT_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 652                                    ? isPRINT_L1(c) : is_uni_print((UV) (c)))
 653 __UNDEFINED__ isPSXSPC_uvchr(c)   isSPACE_uvchr(c)
 654 __UNDEFINED__ isPUNCT_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 655                                    ? isPUNCT_L1(c) : is_uni_punct((UV) (c)))
 656 __UNDEFINED__ isSPACE_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 657                                    ? isSPACE_L1(c) : is_uni_space((UV) (c)))
 658 __UNDEFINED__ isUPPER_uvchr(c)    ((WIDEST_UTYPE) (c) < 256                 \
 659                                    ? isUPPER_L1(c) : is_uni_upper((UV) (c)))
 660 __UNDEFINED__ isXDIGIT_uvchr(c)   ((WIDEST_UTYPE) (c) < 256                 \
 661                                    ? isXDIGIT_L1(c) : is_uni_xdigit((UV) (c)))
 662 __UNDEFINED__ isWORDCHAR_uvchr(c) ((WIDEST_UTYPE) (c) < 256                 \
 663                                    ? isWORDCHAR_L1(c) : is_uni_alnum((UV) (c)))
 664
 665 __UNDEFINED__ isALPHA_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHA)
 666 #  ifdef isALPHANUMERIC_utf8
 667 __UNDEFINED__ isALPHANUMERIC_utf8_safe(s,e)                                 \
 668                                 D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHANUMERIC)
 669 #  else
 670 __UNDEFINED__ isALPHANUMERIC_utf8_safe(s,e)                                 \
 671                         (isALPHA_utf8_safe(s,e) || isDIGIT_utf8_safe(s,e))
 672 #  endif
 673
 674 /* This was broken before 5.18, and just use this instead of worrying about
 675  * which releases the official works on */
 676 #  if 'A' == 65
 677 __UNDEFINED__  isBLANK_utf8_safe(s,e)                                       \
 678 ( ( LIKELY((e) > (s)) ) ?   /* Machine generated */                         \
 679     ( ( 0x09 == ((const U8*)s)[0] || 0x20 == ((const U8*)s)[0] ) ? 1        \
 680     : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ?                              \
 681             ( ( 0xC2 == ((const U8*)s)[0] ) ?                               \
 682                 ( ( 0xA0 == ((const U8*)s)[1] ) ? 2 : 0 )                   \
 683             : ( 0xE1 == ((const U8*)s)[0] ) ?                               \
 684                 ( ( ( 0x9A == ((const U8*)s)[1] ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
 685             : ( 0xE2 == ((const U8*)s)[0] ) ?                               \
 686                 ( ( 0x80 == ((const U8*)s)[1] ) ?                           \
 687                     ( ( inRANGE(((const U8*)s)[2], 0x80, 0x8A ) || 0xAF == ((const U8*)s)[2] ) ? 3 : 0 )\
 688                 : ( ( 0x81 == ((const U8*)s)[1] ) && ( 0x9F == ((const U8*)s)[2] ) ) ? 3 : 0 )\
 689             : ( ( ( 0xE3 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
 690         : 0 )                                                               \
 691  : 0 )
 692
 693 #  elif 'A' == 193  && '^' == 95 /* EBCDIC 1047 */
 694
 695 __UNDEFINED__  isBLANK_utf8_safe(s,e)                                       \
 696 ( ( LIKELY((e) > (s)) ) ?                                                   \
 697     ( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1        \
 698     : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ?                              \
 699             ( ( 0x80 == ((const U8*)s)[0] ) ?                               \
 700                 ( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 )                   \
 701             : ( 0xBC == ((const U8*)s)[0] ) ?                               \
 702                 ( ( ( 0x63 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
 703             : ( 0xCA == ((const U8*)s)[0] ) ?                               \
 704                 ( ( 0x41 == ((const U8*)s)[1] ) ?                           \
 705                     ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\
 706                 : ( 0x42 == ((const U8*)s)[1] ) ?                           \
 707                     ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 )               \
 708                 : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x73 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
 709             : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
 710         : 0 )                                                               \
 711 : 0 )
 712
 713 #  elif 'A' == 193  && '^' == 176 /* EBCDIC 037 */
 714
 715 __UNDEFINED__  isBLANK_utf8_safe(s,e)                                       \
 716 ( ( LIKELY((e) > (s)) ) ?                                                   \
 717     ( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1        \
 718     : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ?                              \
 719             ( ( 0x78 == ((const U8*)s)[0] ) ?                               \
 720                 ( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 )                   \
 721             : ( 0xBD == ((const U8*)s)[0] ) ?                               \
 722                 ( ( ( 0x62 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
 723             : ( 0xCA == ((const U8*)s)[0] ) ?                               \
 724                 ( ( 0x41 == ((const U8*)s)[1] ) ?                           \
 725                     ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\
 726                 : ( 0x42 == ((const U8*)s)[1] ) ?                           \
 727                     ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 )               \
 728                 : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
 729             : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
 730         : 0 )                                                               \
 731 : 0 )
 732
 733 #  else
 734 #    error Unknown character set
 735 #  endif
 736
 737 __UNDEFINED__ isCNTRL_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, CNTRL)
 738 __UNDEFINED__ isDIGIT_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, DIGIT)
 739 __UNDEFINED__ isGRAPH_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, GRAPH)
 740 #  ifdef isIDCONT_utf8
 741 __UNDEFINED__ isIDCONT_utf8_safe(s,e)   D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDCONT)
 742 #  else
 743 __UNDEFINED__ isIDCONT_utf8_safe(s,e)   isWORDCHAR_utf8_safe(s,e)
 744 #  endif
 745
 746 __UNDEFINED__ isIDFIRST_utf8_safe(s,e)  D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDFIRST)
 747 __UNDEFINED__ isLOWER_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, LOWER)
 748 __UNDEFINED__ isPRINT_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PRINT)
 749
 750 #  undef isPSXSPC_utf8_safe   /* Use the modern definition */
 751 __UNDEFINED__ isPSXSPC_utf8_safe(s,e)   isSPACE_utf8_safe(s,e)
 752
 753 __UNDEFINED__ isPUNCT_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PUNCT)
 754 __UNDEFINED__ isSPACE_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, SPACE)
 755 __UNDEFINED__ isUPPER_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, UPPER)
 756
 757 #  ifdef isWORDCHAR_utf8
 758 __UNDEFINED__ isWORDCHAR_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, WORDCHAR)
 759 #  else
 760 __UNDEFINED__ isWORDCHAR_utf8_safe(s,e)                                        \
 761                                (isALPHANUMERIC_utf8_safe(s,e) || (*(s)) == '_')
 762 #  endif
 763
 764 /* This was broken before 5.12, and just use this instead of worrying about
 765  * which releases the official works on */
 766 #  if 'A' == 65
 767 __UNDEFINED__  isXDIGIT_utf8_safe(s,e)                                       \
 768 ( ( LIKELY((e) > (s)) ) ?                                                   \
 769     ( ( inRANGE(((const U8*)s)[0], 0x30, 0x39 ) || inRANGE(((const U8*)s)[0], 0x41, 0x46 ) || inRANGE(((const U8*)s)[0], 0x61, 0x66 ) ) ? 1\
 770     : ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xEF == ((const U8*)s)[0] ) ) ? ( ( 0xBC == ((const U8*)s)[1] ) ?\
 771                     ( ( inRANGE(((const U8*)s)[2], 0x90, 0x99 ) || inRANGE(((const U8*)s)[2], 0xA1, 0xA6 ) ) ? 3 : 0 )\
 772                 : ( ( 0xBD == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x81, 0x86 ) ) ) ? 3 : 0 ) : 0 )\
 773 : 0 )
 774
 775 #  elif 'A' == 193  && '^' == 95 /* EBCDIC 1047 */
 776
 777 __UNDEFINED__  isXDIGIT_utf8_safe(s,e)                                       \
 778 ( ( LIKELY((e) > (s)) ) ?                                                   \
 779     ( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\
 780     : ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x73 == ((const U8*)s)[1] ) ) ? ( ( 0x67 == ((const U8*)s)[2] ) ?\
 781                         ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || inRANGE(((const U8*)s)[3], 0x62, 0x68 ) ) ? 4 : 0 )\
 782                     : ( ( inRANGE(((const U8*)s)[2], 0x68, 0x69 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
 783 : 0 )
 784
 785 #  elif 'A' == 193  && '^' == 176 /* EBCDIC 037 */
 786
 787 __UNDEFINED__  isXDIGIT_utf8_safe(s,e)                                       \
 788 ( ( LIKELY((e) > (s)) ) ?                                                   \
 789     ( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\
 790     : ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x72 == ((const U8*)s)[1] ) ) ? ( ( 0x66 == ((const U8*)s)[2] ) ?\
 791                         ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x67 ) ) ? 4 : 0 )\
 792                     : ( ( inRANGE(((const U8*)s)[2], 0x67, 0x68 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
 793 : 0 )
 794
 795 #  else
 796 #    error Unknown character set
 797 #  endif
 798
 799 /* Warning: isALPHANUMERIC_utf8_safe, isALPHA_utf8_safe, isASCII_utf8_safe,
 800  * isBLANK_utf8_safe, isCNTRL_utf8_safe, isDIGIT_utf8_safe, isGRAPH_utf8_safe,
 801  * isIDCONT_utf8_safe, isIDFIRST_utf8_safe, isLOWER_utf8_safe,
 802  * isPRINT_utf8_safe, isPSXSPC_utf8_safe, isPUNCT_utf8_safe, isSPACE_utf8_safe,
 803  * isUPPER_utf8_safe, isWORDCHAR_utf8_safe, isWORDCHAR_utf8_safe,
 804  * isXDIGIT_utf8_safe,
 805  * isALPHANUMERIC_uvchr, isALPHA_uvchr, isASCII_uvchr, isBLANK_uvchr,
 806  * isCNTRL_uvchr, isDIGIT_uvchr, isGRAPH_uvchr, isIDCONT_uvchr,
 807  * isIDFIRST_uvchr, isLOWER_uvchr, isPRINT_uvchr, isPSXSPC_uvchr,
 808  * isPUNCT_uvchr, isSPACE_uvchr, isUPPER_uvchr, isWORDCHAR_uvchr,
 809  * isWORDCHAR_uvchr, isXDIGIT_uvchr
 810  *
 811  * The UTF-8 handling is buggy in early Perls, and this can give inaccurate
 812  * results for code points above 0xFF, until the implementation started
 813  * settling down in 5.12 and 5.14 */
 814
 815 #endif
 816
 817 #define D_PPP_TOO_SHORT_MSG  "Malformed UTF-8 character starting with:"      \
 818                              " \\x%02x (too short; %d bytes available, need" \
 819                              " %d)\n"
 820 /* Perls starting here had a new API which handled multi-character results */
 821 #if { VERSION >= 5.7.3 }
 822
 823 __UNDEFINED__ toLOWER_uvchr(c, s, l)  UNI_TO_NATIVE(to_uni_lower(NATIVE_TO_UNI(c), s, l))
 824 __UNDEFINED__ toUPPER_uvchr(c, s, l)  UNI_TO_NATIVE(to_uni_upper(NATIVE_TO_UNI(c), s, l))
 825 __UNDEFINED__ toTITLE_uvchr(c, s, l)  UNI_TO_NATIVE(to_uni_title(NATIVE_TO_UNI(c), s, l))
 826 __UNDEFINED__ toFOLD_uvchr(c, s, l)   UNI_TO_NATIVE(to_uni_fold( NATIVE_TO_UNI(c), s, l))
 827
 828 #  if { VERSION != 5.15.6 }     /* Just this version is broken */
 829
 830       /* Prefer the macro to the function */
 831 #    if defined toLOWER_utf8
 832 #      define D_PPP_TO_LOWER_CALLEE(s,r,l)    toLOWER_utf8(s,r,l)
 833 #    else
 834 #      define D_PPP_TO_LOWER_CALLEE(s,r,l)    to_utf8_lower(s,r,l)
 835 #    endif
 836 #    if defined toTITLE_utf8
 837 #      define D_PPP_TO_TITLE_CALLEE(s,r,l)    toTITLE_utf8(s,r,l)
 838 #    else
 839 #      define D_PPP_TO_TITLE_CALLEE(s,r,l)    to_utf8_title(s,r,l)
 840 #    endif
 841 #    if defined toUPPER_utf8
 842 #      define D_PPP_TO_UPPER_CALLEE(s,r,l)    toUPPER_utf8(s,r,l)
 843 #    else
 844 #      define D_PPP_TO_UPPER_CALLEE(s,r,l)    to_utf8_upper(s,r,l)
 845 #    endif
 846 #    if defined toFOLD_utf8
 847 #      define D_PPP_TO_FOLD_CALLEE(s,r,l)     toFOLD_utf8(s,r,l)
 848 #    else
 849 #      define D_PPP_TO_FOLD_CALLEE(s,r,l)     to_utf8_fold(s,r,l)
 850 #    endif
 851 #  else     /* Below is 5.15.6, which failed to make the macros available
 852 #              outside of core, so we have to use the 'Perl_' form.  khw
 853 #              decided it was easier to just handle this case than have to
 854 #              document the exception, and make an exception in the tests below
 855 #              */
 856 #    define D_PPP_TO_LOWER_CALLEE(s,r,l)                                    \
 857                         Perl__to_utf8_lower_flags(aTHX_ s, r, l, 0, NULL)
 858 #    define D_PPP_TO_TITLE_CALLEE(s,r,l)                                    \
 859                         Perl__to_utf8_title_flags(aTHX_ s, r, l, 0, NULL)
 860 #    define D_PPP_TO_UPPER_CALLEE(s,r,l)                                    \
 861                         Perl__to_utf8_upper_flags(aTHX_ s, r, l, 0, NULL)
 862 #    define D_PPP_TO_FOLD_CALLEE(s,r,l)                                     \
 863             Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
 864 #  endif
 865
 866 /* The actual implementation of the backported macros.  If too short, croak,
 867  * otherwise call the original that doesn't have an upper limit parameter */
 868 #  define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l)                        \
 869     (((((e) - (s)) <= 0)                                                    \
 870          /* We could just do nothing, but modern perls croak */             \
 871       ? (croak("Attempting case change on zero length string"),             \
 872          0) /* So looks like it returns something, and will compile */      \
 873       : ((e) - (s)) < UTF8SKIP(s))                                          \
 874         ? (croak(D_PPP_TOO_SHORT_MSG,                                       \
 875                                s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
 876            0)                                                               \
 877         : D_PPP_TO_ ## name ## _CALLEE(s,r,l))
 878
 879 __UNDEFINED__  toUPPER_utf8_safe(s,e,r,l)                                   \
 880                         D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
 881 __UNDEFINED__  toLOWER_utf8_safe(s,e,r,l)                                   \
 882                         D_PPP_GENERIC_MULTI_ARG_TO(LOWER,s,e,r,l)
 883 __UNDEFINED__  toTITLE_utf8_safe(s,e,r,l)                                   \
 884                         D_PPP_GENERIC_MULTI_ARG_TO(TITLE,s,e,r,l)
 885 __UNDEFINED__  toFOLD_utf8_safe(s,e,r,l)                                    \
 886                         D_PPP_GENERIC_MULTI_ARG_TO(FOLD,s,e,r,l)
 887
 888 #elif defined(UTF8SKIP)
 889
 890 /* Here we have UTF-8 support, but using the original API where the case
 891  * changing functions merely returned the changed code point; hence they
 892  * couldn't handle multi-character results. */
 893
 894 #  ifdef uvchr_to_utf8
 895 #    define D_PPP_UV_TO_UTF8 uvchr_to_utf8
 896 #  else
 897 #    define D_PPP_UV_TO_UTF8 uv_to_utf8
 898 #  endif
 899
 900    /* Get the utf8 of the case changed value, and store its length; then have
 901     * to re-calculate the changed case value in order to return it */
 902 #  define D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(name, c, s, l)                  \
 903         (*(l) = (D_PPP_UV_TO_UTF8(s,                                        \
 904                  UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c)))) - (s)),  \
 905         UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c))))
 906
 907 __UNDEFINED__ toLOWER_uvchr(c, s, l)                                        \
 908                         D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(lower, c, s, l)
 909 __UNDEFINED__ toUPPER_uvchr(c, s, l)                                        \
 910                         D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(upper, c, s, l)
 911 __UNDEFINED__ toTITLE_uvchr(c, s, l)                                        \
 912                         D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
 913 __UNDEFINED__ toFOLD_uvchr(c, s, l)   toLOWER_uvchr(c, s, l)
 914
 915 #  define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l)                \
 916     (((((e) - (s)) <= 0)                                                    \
 917       ? (croak("Attempting case change on zero length string"),             \
 918          0) /* So looks like it returns something, and will compile */      \
 919       : ((e) - (s)) < UTF8SKIP(s))                                          \
 920         ? (croak(D_PPP_TOO_SHORT_MSG,                                       \
 921                                s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
 922            0)                                                               \
 923           /* Get the changed code point and store its UTF-8 */              \
 924         : D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)),                         \
 925             /* Then store its length, and re-get code point for return */   \
 926             *(l) = UTF8SKIP(r), to_utf8_ ## name(r))
 927
 928 /* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
 929  * toUPPER_uvchr, toLOWER_uvchr, toTITLE_uvchr
 930     The UTF-8 case changing operations had bugs before around 5.12 or 5.14;
 931     this backport does not correct them.
 932
 933     In perls before 7.3, multi-character case changing is not implemented; this
 934     backport uses the simple case changes available in those perls. */
 935
 936 __UNDEFINED__  toUPPER_utf8_safe(s,e,r,l)                                   \
 937                         D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(upper, s, e, r, l)
 938 __UNDEFINED__  toLOWER_utf8_safe(s,e,r,l)                                   \
 939                         D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(lower, s, e, r, l)
 940 __UNDEFINED__  toTITLE_utf8_safe(s,e,r,l)                                   \
 941                         D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(title, s, e, r, l)
 942
 943  /* Warning: toFOLD_utf8_safe, toFOLD_uvchr
 944     The UTF-8 case changing operations had bugs before around 5.12 or 5.14;
 945     this backport does not correct them.
 946
 947     In perls before 7.3, case folding is not implemented; instead, this
 948     backport substitutes simple (not multi-character, which isn't available)
 949     lowercasing.  This gives the correct result in most, but not all, instances
 950     */
 951
 952 __UNDEFINED__  toFOLD_utf8_safe(s,e,r,l)  toLOWER_utf8_safe(s,e,r,l)
 953
 954 #endif
 955
 956 /* Until we figure out how to support this in older perls... */
 957 #if { VERSION >= 5.8.0 }
 958
 959 __UNDEFINED__ HeUTF8(he)        ((HeKLEN(he) == HEf_SVKEY) ?            \
 960                                  SvUTF8(HeKEY_sv(he)) :                 \
 961                                  (U32)HeKUTF8(he))
 962
 963 #endif
 964
 965 __UNDEFINED__ C_ARRAY_LENGTH(a)         (sizeof(a)/sizeof((a)[0]))
 966 __UNDEFINED__ C_ARRAY_END(a)            ((a) + C_ARRAY_LENGTH(a))
 967
 968 __UNDEFINED__ LIKELY(x) (x)
 969 __UNDEFINED__ UNLIKELY(x) (x)
 970
 971 #ifndef MUTABLE_PTR
 972 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
 973 #  define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
 974 #else
 975 #  define MUTABLE_PTR(p) ((void *) (p))
 976 #endif
 977 #endif
 978
 979 __UNDEFINED__ MUTABLE_SV(p)   ((SV *)MUTABLE_PTR(p))
 980
 981 =xsmisc
 982
 983 typedef XSPROTO(XSPROTO_test_t);
 984 typedef XSPROTO_test_t *XSPROTO_test_t_ptr;
 985
 986 XS(XS_Devel__PPPort_dXSTARG);  /* prototype */
 987 XS(XS_Devel__PPPort_dXSTARG)
 988 {
 989   dXSARGS;
 990   dXSTARG;
 991   IV iv;
 992
 993   PERL_UNUSED_VAR(cv);
 994   SP -= items;
 995   iv = SvIV(ST(0)) + 1;
 996   PUSHi(iv);
 997   XSRETURN(1);
 998 }
 999
1000 XS(XS_Devel__PPPort_dAXMARK);  /* prototype */
1001 XS(XS_Devel__PPPort_dAXMARK)
1002 {
1003   dSP;
1004   dAXMARK;
1005   dITEMS;
1006   IV iv;
1007
1008   PERL_UNUSED_VAR(cv);
1009   SP -= items;
1010   iv = SvIV(ST(0)) - 1;
1011   mPUSHi(iv);
1012   XSRETURN(1);
1013 }
1014
1015 =xsboot
1016
1017 {
1018   XSPROTO_test_t_ptr p = &XS_Devel__PPPort_dXSTARG;
1019   newXS("Devel::PPPort::dXSTARG", *p, file);
1020 }
1021 newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
1022
1023 =xsubs
1024
1025 int
1026 OpSIBLING_tests()
1027         PREINIT:
1028                 OP *x;
1029                 OP *kid;
1030                 OP *middlekid;
1031                 OP *lastkid;
1032                 int count = 0;
1033                 int failures = 0;
1034                 int i;
1035         CODE:
1036                 x = newOP(OP_PUSHMARK, 0);
1037
1038                 /* No siblings yet! */
1039                 if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
1040                         failures++; warn("Op should not have had a sib");
1041                 }
1042
1043
1044                 /* Add 2 siblings */
1045                 kid = x;
1046
1047                 for (i = 0; i < 2; i++) {
1048                         OP *newsib = newOP(OP_PUSHMARK, 0);
1049                         OpMORESIB_set(kid, newsib);
1050
1051                         kid = OpSIBLING(kid);
1052                         lastkid = kid;
1053                 }
1054                 middlekid = OpSIBLING(x);
1055
1056                 /* Should now have a sibling */
1057                 if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
1058                         failures++; warn("Op should have had a sib after moresib_set");
1059                 }
1060
1061                 /* Count the siblings */
1062                 for (kid = OpSIBLING(x); kid; kid = OpSIBLING(kid)) {
1063                         count++;
1064                 }
1065
1066                 if (count != 2) {
1067                         failures++; warn("Kid had %d sibs, expected 2", count);
1068                 }
1069
1070                 if (OpHAS_SIBLING(lastkid) || OpSIBLING(lastkid)) {
1071                         failures++; warn("Last kid should not have a sib");
1072                 }
1073
1074                 /* Really sets the parent, and says 'no more siblings' */
1075                 OpLASTSIB_set(x, lastkid);
1076
1077                 if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
1078                         failures++; warn("OpLASTSIB_set failed?");
1079                 }
1080
1081                 /* Restore the kid */
1082                 OpMORESIB_set(x, lastkid);
1083
1084                 /* Try to remove it again */
1085                 OpLASTSIB_set(x, NULL);
1086
1087                 if (OpHAS_SIBLING(x) || OpSIBLING(x)) {
1088                         failures++; warn("OpLASTSIB_set with NULL failed?");
1089                 }
1090
1091                 /* Try to restore with maybesib_set */
1092                 OpMAYBESIB_set(x, lastkid, NULL);
1093
1094                 if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
1095                         failures++; warn("Op should have had a sib after maybesibset");
1096                 }
1097
1098                 op_free(lastkid);
1099                 op_free(middlekid);
1100                 op_free(x);
1101                 RETVAL = failures;
1102         OUTPUT:
1103                 RETVAL
1104
1105 int
1106 SvRXOK(sv)
1107         SV *sv
1108         CODE:
1109                 RETVAL = SvRXOK(sv);
1110         OUTPUT:
1111                 RETVAL
1112
1113 int
1114 ptrtests()
1115         PREINIT:
1116                 int var, *p = &var;
1117
1118         CODE:
1119                 RETVAL = 0;
1120                 RETVAL += PTR2nat(p) != 0       ?  1 : 0;
1121                 RETVAL += PTR2ul(p) != 0UL      ?  2 : 0;
1122                 RETVAL += PTR2UV(p) != (UV) 0   ?  4 : 0;
1123                 RETVAL += PTR2IV(p) != (IV) 0   ?  8 : 0;
1124                 RETVAL += PTR2NV(p) != (NV) 0   ? 16 : 0;
1125                 RETVAL += p > NUM2PTR(int *, 0) ? 32 : 0;
1126
1127         OUTPUT:
1128                 RETVAL
1129
1130 int
1131 gv_stashpvn(name, create)
1132         char *name
1133         I32 create
1134         CODE:
1135                 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
1136         OUTPUT:
1137                 RETVAL
1138
1139 int
1140 get_sv(name, create)
1141         char *name
1142         I32 create
1143         CODE:
1144                 RETVAL = get_sv(name, create) != NULL;
1145         OUTPUT:
1146                 RETVAL
1147
1148 int
1149 get_av(name, create)
1150         char *name
1151         I32 create
1152         CODE:
1153                 RETVAL = get_av(name, create) != NULL;
1154         OUTPUT:
1155                 RETVAL
1156
1157 int
1158 get_hv(name, create)
1159         char *name
1160         I32 create
1161         CODE:
1162                 RETVAL = get_hv(name, create) != NULL;
1163         OUTPUT:
1164                 RETVAL
1165
1166 int
1167 get_cv(name, create)
1168         char *name
1169         I32 create
1170         CODE:
1171                 RETVAL = get_cv(name, create) != NULL;
1172         OUTPUT:
1173                 RETVAL
1174
1175 void
1176 xsreturn(two)
1177         int two
1178         PPCODE:
1179                 mXPUSHp("test1", 5);
1180                 if (two)
1181                   mXPUSHp("test2", 5);
1182                 if (two)
1183                   XSRETURN(2);
1184                 else
1185                   XSRETURN(1);
1186
1187 SV*
1188 boolSV(value)
1189         int value
1190         CODE:
1191                 RETVAL = newSVsv(boolSV(value));
1192         OUTPUT:
1193                 RETVAL
1194
1195 SV*
1196 DEFSV()
1197         CODE:
1198                 RETVAL = newSVsv(DEFSV);
1199         OUTPUT:
1200                 RETVAL
1201
1202 void
1203 DEFSV_modify()
1204         PPCODE:
1205                 XPUSHs(sv_mortalcopy(DEFSV));
1206                 ENTER;
1207                 SAVE_DEFSV;
1208                 DEFSV_set(newSVpvs("DEFSV"));
1209                 XPUSHs(sv_mortalcopy(DEFSV));
1210                 /* Yes, this leaks the above scalar; 5.005 with threads for some reason */
1211                 /* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */
1212                 /* sv_2mortal(DEFSV); */
1213                 LEAVE;
1214                 XPUSHs(sv_mortalcopy(DEFSV));
1215                 XSRETURN(3);
1216
1217 int
1218 ERRSV()
1219         CODE:
1220                 RETVAL = SvTRUEx(ERRSV);
1221         OUTPUT:
1222                 RETVAL
1223
1224 SV*
1225 UNDERBAR()
1226         CODE:
1227                 {
1228                   dUNDERBAR;
1229                   RETVAL = newSVsv(UNDERBAR);
1230                 }
1231         OUTPUT:
1232                 RETVAL
1233
1234 void
1235 prepush()
1236         CODE:
1237                 {
1238                   dXSTARG;
1239                   XSprePUSH;
1240                   PUSHi(42);
1241                   XSRETURN(1);
1242                 }
1243
1244 int
1245 PERL_ABS(a)
1246         int a
1247
1248 void
1249 SVf(x)
1250         SV *x
1251         PPCODE:
1252 #if { VERSION >= 5.004 }
1253                 x = sv_2mortal(newSVpvf("[%" SVf "]", SVfARG(x)));
1254 #endif
1255                 XPUSHs(x);
1256                 XSRETURN(1);
1257
1258 void
1259 Perl_ppaddr_t(string)
1260         char *string
1261         PREINIT:
1262                 Perl_ppaddr_t lower;
1263         PPCODE:
1264                 lower = PL_ppaddr[OP_LC];
1265                 mXPUSHs(newSVpv(string, 0));
1266                 PUTBACK;
1267                 ENTER;
1268                 (void)*(lower)(aTHXR);
1269                 SPAGAIN;
1270                 LEAVE;
1271                 XSRETURN(1);
1272
1273 #if { VERSION >= 5.8.0 }
1274
1275 void
1276 check_HeUTF8(utf8_key)
1277         SV *utf8_key;
1278         PREINIT:
1279                 HV *hash;
1280                 HE *ent;
1281                 STRLEN klen;
1282                 char *key;
1283         PPCODE:
1284                 hash = newHV();
1285
1286                 key = SvPV(utf8_key, klen);
1287                 if (SvUTF8(utf8_key)) klen *= -1;
1288                 hv_store(hash, key, klen, newSVpvs("string"), 0);
1289                 hv_iterinit(hash);
1290                 ent = hv_iternext(hash);
1291                 assert(ent);
1292                 mXPUSHp((HeUTF8(ent) == 0 ? "norm" : "utf8"), 4);
1293                 hv_undef(hash);
1294
1295
1296 #endif
1297
1298 void
1299 check_c_array()
1300         PREINIT:
1301                 int x[] = { 10, 11, 12, 13 };
1302         PPCODE:
1303                 mXPUSHi(C_ARRAY_LENGTH(x));  /* 4 */
1304                 mXPUSHi(*(C_ARRAY_END(x)-1)); /* 13 */
1305
1306 bool
1307 isBLANK(ord)
1308     UV ord
1309     CODE:
1310         RETVAL = isBLANK(ord);
1311     OUTPUT:
1312         RETVAL
1313
1314 bool
1315 isBLANK_A(ord)
1316     UV ord
1317     CODE:
1318         RETVAL = isBLANK_A(ord);
1319     OUTPUT:
1320         RETVAL
1321
1322 bool
1323 isBLANK_L1(ord)
1324     UV ord
1325     CODE:
1326         RETVAL = isBLANK_L1(ord);
1327     OUTPUT:
1328         RETVAL
1329
1330 bool
1331 isUPPER(ord)
1332     UV ord
1333     CODE:
1334         RETVAL = isUPPER(ord);
1335     OUTPUT:
1336         RETVAL
1337
1338 bool
1339 isUPPER_A(ord)
1340     UV ord
1341     CODE:
1342         RETVAL = isUPPER_A(ord);
1343     OUTPUT:
1344         RETVAL
1345
1346 bool
1347 isUPPER_L1(ord)
1348     UV ord
1349     CODE:
1350         RETVAL = isUPPER_L1(ord);
1351     OUTPUT:
1352         RETVAL
1353
1354 bool
1355 isLOWER(ord)
1356     UV ord
1357     CODE:
1358         RETVAL = isLOWER(ord);
1359     OUTPUT:
1360         RETVAL
1361
1362 bool
1363 isLOWER_A(ord)
1364     UV ord
1365     CODE:
1366         RETVAL = isLOWER_A(ord);
1367     OUTPUT:
1368         RETVAL
1369
1370 bool
1371 isLOWER_L1(ord)
1372     UV ord
1373     CODE:
1374         RETVAL = isLOWER_L1(ord);
1375     OUTPUT:
1376         RETVAL
1377
1378 bool
1379 isALPHA(ord)
1380     UV ord
1381     CODE:
1382         RETVAL = isALPHA(ord);
1383     OUTPUT:
1384         RETVAL
1385
1386 bool
1387 isALPHA_A(ord)
1388     UV ord
1389     CODE:
1390         RETVAL = isALPHA_A(ord);
1391     OUTPUT:
1392         RETVAL
1393
1394 bool
1395 isALPHA_L1(ord)
1396     UV ord
1397     CODE:
1398         RETVAL = isALPHA_L1(ord);
1399     OUTPUT:
1400         RETVAL
1401
1402 bool
1403 isWORDCHAR(ord)
1404     UV ord
1405     CODE:
1406         RETVAL = isWORDCHAR(ord);
1407     OUTPUT:
1408         RETVAL
1409
1410 bool
1411 isWORDCHAR_A(ord)
1412     UV ord
1413     CODE:
1414         RETVAL = isWORDCHAR_A(ord);
1415     OUTPUT:
1416         RETVAL
1417
1418 bool
1419 isWORDCHAR_L1(ord)
1420     UV ord
1421     CODE:
1422         RETVAL = isWORDCHAR_L1(ord);
1423     OUTPUT:
1424         RETVAL
1425
1426 bool
1427 isALPHANUMERIC(ord)
1428     UV ord
1429     CODE:
1430         RETVAL = isALPHANUMERIC(ord);
1431     OUTPUT:
1432         RETVAL
1433
1434 bool
1435 isALPHANUMERIC_A(ord)
1436     UV ord
1437     CODE:
1438         RETVAL = isALPHANUMERIC_A(ord);
1439     OUTPUT:
1440         RETVAL
1441
1442 bool
1443 isALNUM(ord)
1444     UV ord
1445     CODE:
1446         RETVAL = isALNUM(ord);
1447     OUTPUT:
1448         RETVAL
1449
1450 bool
1451 isALNUM_A(ord)
1452     UV ord
1453     CODE:
1454         RETVAL = isALNUM_A(ord);
1455     OUTPUT:
1456         RETVAL
1457
1458 bool
1459 isDIGIT(ord)
1460     UV ord
1461     CODE:
1462         RETVAL = isDIGIT(ord);
1463     OUTPUT:
1464         RETVAL
1465
1466 bool
1467 isDIGIT_A(ord)
1468     UV ord
1469     CODE:
1470         RETVAL = isDIGIT_A(ord);
1471     OUTPUT:
1472         RETVAL
1473
1474 bool
1475 isOCTAL(ord)
1476     UV ord
1477     CODE:
1478         RETVAL = isOCTAL(ord);
1479     OUTPUT:
1480         RETVAL
1481
1482 bool
1483 isOCTAL_A(ord)
1484     UV ord
1485     CODE:
1486         RETVAL = isOCTAL_A(ord);
1487     OUTPUT:
1488         RETVAL
1489
1490 bool
1491 isIDFIRST(ord)
1492     UV ord
1493     CODE:
1494         RETVAL = isIDFIRST(ord);
1495     OUTPUT:
1496         RETVAL
1497
1498 bool
1499 isIDFIRST_A(ord)
1500     UV ord
1501     CODE:
1502         RETVAL = isIDFIRST_A(ord);
1503     OUTPUT:
1504         RETVAL
1505
1506 bool
1507 isIDCONT(ord)
1508     UV ord
1509     CODE:
1510         RETVAL = isIDCONT(ord);
1511     OUTPUT:
1512         RETVAL
1513
1514 bool
1515 isIDCONT_A(ord)
1516     UV ord
1517     CODE:
1518         RETVAL = isIDCONT_A(ord);
1519     OUTPUT:
1520         RETVAL
1521
1522 bool
1523 isSPACE(ord)
1524     UV ord
1525     CODE:
1526         RETVAL = isSPACE(ord);
1527     OUTPUT:
1528         RETVAL
1529
1530 bool
1531 isSPACE_A(ord)
1532     UV ord
1533     CODE:
1534         RETVAL = isSPACE_A(ord);
1535     OUTPUT:
1536         RETVAL
1537
1538 bool
1539 isASCII(ord)
1540     UV ord
1541     CODE:
1542         RETVAL = isASCII(ord);
1543     OUTPUT:
1544         RETVAL
1545
1546 bool
1547 isASCII_A(ord)
1548     UV ord
1549     CODE:
1550         RETVAL = isASCII_A(ord);
1551     OUTPUT:
1552         RETVAL
1553
1554 bool
1555 isCNTRL(ord)
1556     UV ord
1557     CODE:
1558         RETVAL = isCNTRL(ord);
1559     OUTPUT:
1560         RETVAL
1561
1562 bool
1563 isCNTRL_A(ord)
1564     UV ord
1565     CODE:
1566         RETVAL = isCNTRL_A(ord);
1567     OUTPUT:
1568         RETVAL
1569
1570 bool
1571 isPRINT(ord)
1572     UV ord
1573     CODE:
1574         RETVAL = isPRINT(ord);
1575     OUTPUT:
1576         RETVAL
1577
1578 bool
1579 isPRINT_A(ord)
1580     UV ord
1581     CODE:
1582         RETVAL = isPRINT_A(ord);
1583     OUTPUT:
1584         RETVAL
1585
1586 bool
1587 isGRAPH(ord)
1588     UV ord
1589     CODE:
1590         RETVAL = isGRAPH(ord);
1591     OUTPUT:
1592         RETVAL
1593
1594 bool
1595 isGRAPH_A(ord)
1596     UV ord
1597     CODE:
1598         RETVAL = isGRAPH_A(ord);
1599     OUTPUT:
1600         RETVAL
1601
1602 bool
1603 isPUNCT(ord)
1604     UV ord
1605     CODE:
1606         RETVAL = isPUNCT(ord);
1607     OUTPUT:
1608         RETVAL
1609
1610 bool
1611 isPUNCT_A(ord)
1612     UV ord
1613     CODE:
1614         RETVAL = isPUNCT_A(ord);
1615     OUTPUT:
1616         RETVAL
1617
1618 bool
1619 isXDIGIT(ord)
1620     UV ord
1621     CODE:
1622         RETVAL = isXDIGIT(ord);
1623     OUTPUT:
1624         RETVAL
1625
1626 bool
1627 isXDIGIT_A(ord)
1628     UV ord
1629     CODE:
1630         RETVAL = isXDIGIT_A(ord);
1631     OUTPUT:
1632         RETVAL
1633
1634 bool
1635 isPSXSPC(ord)
1636     UV ord
1637     CODE:
1638         RETVAL = isPSXSPC(ord);
1639     OUTPUT:
1640         RETVAL
1641
1642 bool
1643 isPSXSPC_A(ord)
1644     UV ord
1645     CODE:
1646         RETVAL = isPSXSPC_A(ord);
1647     OUTPUT:
1648         RETVAL
1649
1650 bool
1651 isALPHANUMERIC_L1(ord)
1652     UV ord
1653     CODE:
1654         RETVAL = isALPHANUMERIC_L1(ord);
1655     OUTPUT:
1656         RETVAL
1657
1658 bool
1659 isALNUMC_L1(ord)
1660     UV ord
1661     CODE:
1662         RETVAL = isALNUMC_L1(ord);
1663     OUTPUT:
1664         RETVAL
1665
1666 bool
1667 isDIGIT_L1(ord)
1668     UV ord
1669     CODE:
1670         RETVAL = isDIGIT_L1(ord);
1671     OUTPUT:
1672         RETVAL
1673
1674 bool
1675 isOCTAL_L1(ord)
1676     UV ord
1677     CODE:
1678         RETVAL = isOCTAL_L1(ord);
1679     OUTPUT:
1680         RETVAL
1681
1682 bool
1683 isIDFIRST_L1(ord)
1684     UV ord
1685     CODE:
1686         RETVAL = isIDFIRST_L1(ord);
1687     OUTPUT:
1688         RETVAL
1689
1690 bool
1691 isIDCONT_L1(ord)
1692     UV ord
1693     CODE:
1694         RETVAL = isIDCONT_L1(ord);
1695     OUTPUT:
1696         RETVAL
1697
1698 bool
1699 isSPACE_L1(ord)
1700     UV ord
1701     CODE:
1702         RETVAL = isSPACE_L1(ord);
1703     OUTPUT:
1704         RETVAL
1705
1706 bool
1707 isASCII_L1(ord)
1708     UV ord
1709     CODE:
1710         RETVAL = isASCII_L1(ord);
1711     OUTPUT:
1712         RETVAL
1713
1714 bool
1715 isCNTRL_L1(ord)
1716     UV ord
1717     CODE:
1718         RETVAL = isCNTRL_L1(ord);
1719     OUTPUT:
1720         RETVAL
1721
1722 bool
1723 isPRINT_L1(ord)
1724     UV ord
1725     CODE:
1726         RETVAL = isPRINT_L1(ord);
1727     OUTPUT:
1728         RETVAL
1729
1730 bool
1731 isGRAPH_L1(ord)
1732     UV ord
1733     CODE:
1734         RETVAL = isGRAPH_L1(ord);
1735     OUTPUT:
1736         RETVAL
1737
1738 bool
1739 isPUNCT_L1(ord)
1740     UV ord
1741     CODE:
1742         RETVAL = isPUNCT_L1(ord);
1743     OUTPUT:
1744         RETVAL
1745
1746 bool
1747 isXDIGIT_L1(ord)
1748     UV ord
1749     CODE:
1750         RETVAL = isXDIGIT_L1(ord);
1751     OUTPUT:
1752         RETVAL
1753
1754 bool
1755 isPSXSPC_L1(ord)
1756     UV ord
1757     CODE:
1758         RETVAL = isPSXSPC_L1(ord);
1759     OUTPUT:
1760         RETVAL
1761
1762 bool
1763 isASCII_uvchr(ord)
1764     UV ord
1765     CODE:
1766         RETVAL = isASCII_uvchr(ord);
1767     OUTPUT:
1768         RETVAL
1769
1770 bool
1771 isASCII_utf8_safe(s, offset)
1772     unsigned char * s
1773     int offset
1774     CODE:
1775         RETVAL = isASCII_utf8_safe(s, s + 1 + offset);
1776     OUTPUT:
1777         RETVAL
1778
1779 #if { VERSION >= 5.006 }
1780
1781 bool
1782 isBLANK_uvchr(ord)
1783     UV ord
1784     CODE:
1785         RETVAL = isBLANK_uvchr(ord);
1786     OUTPUT:
1787         RETVAL
1788
1789 bool
1790 isALPHA_uvchr(ord)
1791     UV ord
1792     CODE:
1793         RETVAL = isALPHA_uvchr(ord);
1794     OUTPUT:
1795         RETVAL
1796
1797 bool
1798 isALPHANUMERIC_uvchr(ord)
1799     UV ord
1800     CODE:
1801         RETVAL = isALPHANUMERIC_uvchr(ord);
1802     OUTPUT:
1803         RETVAL
1804
1805 bool
1806 isCNTRL_uvchr(ord)
1807     UV ord
1808     CODE:
1809         RETVAL = isCNTRL_uvchr(ord);
1810     OUTPUT:
1811         RETVAL
1812
1813 bool
1814 isDIGIT_uvchr(ord)
1815     UV ord
1816     CODE:
1817         RETVAL = isDIGIT_uvchr(ord);
1818     OUTPUT:
1819         RETVAL
1820
1821 bool
1822 isIDFIRST_uvchr(ord)
1823     UV ord
1824     CODE:
1825         RETVAL = isIDFIRST_uvchr(ord);
1826     OUTPUT:
1827         RETVAL
1828
1829 bool
1830 isIDCONT_uvchr(ord)
1831     UV ord
1832     CODE:
1833         RETVAL = isIDCONT_uvchr(ord);
1834     OUTPUT:
1835         RETVAL
1836
1837 bool
1838 isGRAPH_uvchr(ord)
1839     UV ord
1840     CODE:
1841         RETVAL = isGRAPH_uvchr(ord);
1842     OUTPUT:
1843         RETVAL
1844
1845 bool
1846 isLOWER_uvchr(ord)
1847     UV ord
1848     CODE:
1849         RETVAL = isLOWER_uvchr(ord);
1850     OUTPUT:
1851         RETVAL
1852
1853 bool
1854 isPRINT_uvchr(ord)
1855     UV ord
1856     CODE:
1857         RETVAL = isPRINT_uvchr(ord);
1858     OUTPUT:
1859         RETVAL
1860
1861 bool
1862 isPSXSPC_uvchr(ord)
1863     UV ord
1864     CODE:
1865         RETVAL = isPSXSPC_uvchr(ord);
1866     OUTPUT:
1867         RETVAL
1868
1869 bool
1870 isPUNCT_uvchr(ord)
1871     UV ord
1872     CODE:
1873         RETVAL = isPUNCT_uvchr(ord);
1874     OUTPUT:
1875         RETVAL
1876
1877 bool
1878 isSPACE_uvchr(ord)
1879     UV ord
1880     CODE:
1881         RETVAL = isSPACE_uvchr(ord);
1882     OUTPUT:
1883         RETVAL
1884
1885 bool
1886 isUPPER_uvchr(ord)
1887     UV ord
1888     CODE:
1889         RETVAL = isUPPER_uvchr(ord);
1890     OUTPUT:
1891         RETVAL
1892
1893 bool
1894 isWORDCHAR_uvchr(ord)
1895     UV ord
1896     CODE:
1897         RETVAL = isWORDCHAR_uvchr(ord);
1898     OUTPUT:
1899         RETVAL
1900
1901 bool
1902 isXDIGIT_uvchr(ord)
1903     UV ord
1904     CODE:
1905         RETVAL = isXDIGIT_uvchr(ord);
1906     OUTPUT:
1907         RETVAL
1908
1909 bool
1910 isALPHA_utf8_safe(s, offset)
1911     unsigned char * s
1912     int offset
1913     CODE:
1914         RETVAL = isALPHA_utf8_safe(s, s + UTF8SKIP(s) + offset);
1915     OUTPUT:
1916         RETVAL
1917
1918 bool
1919 isALPHANUMERIC_utf8_safe(s, offset)
1920     unsigned char * s
1921     int offset
1922     CODE:
1923         RETVAL = isALPHANUMERIC_utf8_safe(s, s + UTF8SKIP(s) + offset);
1924     OUTPUT:
1925         RETVAL
1926
1927 bool
1928 isBLANK_utf8_safe(s, offset)
1929     unsigned char * s
1930     int offset
1931     CODE:
1932         RETVAL = isBLANK_utf8_safe(s, s + UTF8SKIP(s) + offset);
1933     OUTPUT:
1934         RETVAL
1935
1936 bool
1937 isCNTRL_utf8_safe(s, offset)
1938     unsigned char * s
1939     int offset
1940     CODE:
1941         RETVAL = isCNTRL_utf8_safe(s, s + UTF8SKIP(s) + offset);
1942     OUTPUT:
1943         RETVAL
1944
1945 bool
1946 isDIGIT_utf8_safe(s, offset)
1947     unsigned char * s
1948     int offset
1949     CODE:
1950         RETVAL = isDIGIT_utf8_safe(s, s + UTF8SKIP(s) + offset);
1951     OUTPUT:
1952         RETVAL
1953
1954 bool
1955 isGRAPH_utf8_safe(s, offset)
1956     unsigned char * s
1957     int offset
1958     CODE:
1959         RETVAL = isGRAPH_utf8_safe(s, s + UTF8SKIP(s) + offset);
1960     OUTPUT:
1961         RETVAL
1962
1963 bool
1964 isIDCONT_utf8_safe(s, offset)
1965     unsigned char * s
1966     int offset
1967     CODE:
1968         RETVAL = isIDCONT_utf8_safe(s, s + UTF8SKIP(s) + offset);
1969     OUTPUT:
1970         RETVAL
1971
1972 bool
1973 isIDFIRST_utf8_safe(s, offset)
1974     unsigned char * s
1975     int offset
1976     CODE:
1977         RETVAL = isIDFIRST_utf8_safe(s, s + UTF8SKIP(s) + offset);
1978     OUTPUT:
1979         RETVAL
1980
1981 bool
1982 isLOWER_utf8_safe(s, offset)
1983     unsigned char * s
1984     int offset
1985     CODE:
1986         RETVAL = isLOWER_utf8_safe(s, s + UTF8SKIP(s) + offset);
1987     OUTPUT:
1988         RETVAL
1989
1990 bool
1991 isPRINT_utf8_safe(s, offset)
1992     unsigned char * s
1993     int offset
1994     CODE:
1995         RETVAL = isPRINT_utf8_safe(s, s + UTF8SKIP(s) + offset);
1996     OUTPUT:
1997         RETVAL
1998
1999 bool
2000 isPSXSPC_utf8_safe(s, offset)
2001     unsigned char * s
2002     int offset
2003     CODE:
2004         RETVAL = isPSXSPC_utf8_safe(s, s + UTF8SKIP(s) + offset);
2005     OUTPUT:
2006         RETVAL
2007
2008 bool
2009 isPUNCT_utf8_safe(s, offset)
2010     unsigned char * s
2011     int offset
2012     CODE:
2013         RETVAL = isPUNCT_utf8_safe(s, s + UTF8SKIP(s) + offset);
2014     OUTPUT:
2015         RETVAL
2016
2017 bool
2018 isSPACE_utf8_safe(s, offset)
2019     unsigned char * s
2020     int offset
2021     CODE:
2022         RETVAL = isSPACE_utf8_safe(s, s + UTF8SKIP(s) + offset);
2023     OUTPUT:
2024         RETVAL
2025
2026 bool
2027 isUPPER_utf8_safe(s, offset)
2028     unsigned char * s
2029     int offset
2030     CODE:
2031         RETVAL = isUPPER_utf8_safe(s, s + UTF8SKIP(s) + offset);
2032     OUTPUT:
2033         RETVAL
2034
2035 bool
2036 isWORDCHAR_utf8_safe(s, offset)
2037     unsigned char * s
2038     int offset
2039     CODE:
2040         RETVAL = isWORDCHAR_utf8_safe(s, s + UTF8SKIP(s) + offset);
2041     OUTPUT:
2042         RETVAL
2043
2044 bool
2045 isXDIGIT_utf8_safe(s, offset)
2046     unsigned char * s
2047     int offset
2048     CODE:
2049         RETVAL = isXDIGIT_utf8_safe(s, s + UTF8SKIP(s) + offset);
2050     OUTPUT:
2051         RETVAL
2052
2053 AV *
2054 toLOWER_utf8_safe(s, offset)
2055     unsigned char * s
2056     int offset
2057     PREINIT:
2058         U8 u[UTF8_MAXBYTES+1];
2059         Size_t len;
2060         UV ret;
2061         SV* utf8;
2062         AV * av;
2063     CODE:
2064         av = newAV();
2065         ret = toLOWER_utf8_safe(s, s + UTF8SKIP(s) + offset, u, &len);
2066         av_push(av, newSVuv(ret));
2067
2068         utf8 = newSVpvn((char *) u, len);
2069         SvUTF8_on(utf8);
2070         av_push(av, utf8);
2071
2072         av_push(av, newSVuv(len));
2073         RETVAL = av;
2074     OUTPUT:
2075         RETVAL
2076
2077 AV *
2078 toTITLE_utf8_safe(s, offset)
2079     unsigned char * s
2080     int offset
2081     PREINIT:
2082         U8 u[UTF8_MAXBYTES+1];
2083         Size_t len;
2084         UV ret;
2085         SV* utf8;
2086         AV * av;
2087     CODE:
2088         av = newAV();
2089         ret = toTITLE_utf8_safe(s, s + UTF8SKIP(s) + offset, u, &len);
2090         av_push(av, newSVuv(ret));
2091
2092         utf8 = newSVpvn((char *) u, len);
2093         SvUTF8_on(utf8);
2094         av_push(av, utf8);
2095
2096         av_push(av, newSVuv(len));
2097         RETVAL = av;
2098     OUTPUT:
2099         RETVAL
2100
2101 AV *
2102 toUPPER_utf8_safe(s, offset)
2103     unsigned char * s
2104     int offset
2105     PREINIT:
2106         U8 u[UTF8_MAXBYTES+1];
2107         Size_t len;
2108         UV ret;
2109         SV* utf8;
2110         AV * av;
2111     CODE:
2112         av = newAV();
2113         ret = toUPPER_utf8_safe(s, s + UTF8SKIP(s) + offset, u, &len);
2114         av_push(av, newSVuv(ret));
2115
2116         utf8 = newSVpvn((char *) u, len);
2117         SvUTF8_on(utf8);
2118         av_push(av, utf8);
2119
2120         av_push(av, newSVuv(len));
2121         RETVAL = av;
2122     OUTPUT:
2123         RETVAL
2124
2125 AV *
2126 toFOLD_utf8_safe(s, offset)
2127     unsigned char * s
2128     int offset
2129     PREINIT:
2130         U8 u[UTF8_MAXBYTES+1];
2131         Size_t len;
2132         UV ret;
2133         SV* utf8;
2134         AV * av;
2135     CODE:
2136         av = newAV();
2137         ret = toFOLD_utf8_safe(s, s + UTF8SKIP(s) + offset, u, &len);
2138         av_push(av, newSVuv(ret));
2139
2140         utf8 = newSVpvn((char *) u, len);
2141         SvUTF8_on(utf8);
2142         av_push(av, utf8);
2143
2144         av_push(av, newSVuv(len));
2145         RETVAL = av;
2146     OUTPUT:
2147         RETVAL
2148
2149 AV *
2150 toLOWER_uvchr(c)
2151     UV c
2152     PREINIT:
2153         U8 u[UTF8_MAXBYTES+1];
2154         Size_t len;
2155         UV ret;
2156         SV* utf8;
2157         AV * av;
2158     CODE:
2159         av = newAV();
2160         ret = toLOWER_uvchr(c, u, &len);
2161         av_push(av, newSVuv(ret));
2162
2163         utf8 = newSVpvn((char *) u, len);
2164         SvUTF8_on(utf8);
2165         av_push(av, utf8);
2166
2167         av_push(av, newSVuv(len));
2168         RETVAL = av;
2169     OUTPUT:
2170         RETVAL
2171
2172 AV *
2173 toTITLE_uvchr(c)
2174     UV c
2175     PREINIT:
2176         U8 u[UTF8_MAXBYTES+1];
2177         Size_t len;
2178         UV ret;
2179         SV* utf8;
2180         AV * av;
2181     CODE:
2182         av = newAV();
2183         ret = toTITLE_uvchr(c, u, &len);
2184         av_push(av, newSVuv(ret));
2185
2186         utf8 = newSVpvn((char *) u, len);
2187         SvUTF8_on(utf8);
2188         av_push(av, utf8);
2189
2190         av_push(av, newSVuv(len));
2191         RETVAL = av;
2192     OUTPUT:
2193         RETVAL
2194
2195 AV *
2196 toUPPER_uvchr(c)
2197     UV c
2198     PREINIT:
2199         U8 u[UTF8_MAXBYTES+1];
2200         Size_t len;
2201         UV ret;
2202         SV* utf8;
2203         AV * av;
2204     CODE:
2205         av = newAV();
2206         ret = toUPPER_uvchr(c, u, &len);
2207         av_push(av, newSVuv(ret));
2208
2209         utf8 = newSVpvn((char *) u, len);
2210         SvUTF8_on(utf8);
2211         av_push(av, utf8);
2212
2213         av_push(av, newSVuv(len));
2214         RETVAL = av;
2215     OUTPUT:
2216         RETVAL
2217
2218 AV *
2219 toFOLD_uvchr(c)
2220     UV c
2221     PREINIT:
2222         U8 u[UTF8_MAXBYTES+1];
2223         Size_t len;
2224         UV ret;
2225         SV* utf8;
2226         AV * av;
2227     CODE:
2228         av = newAV();
2229         ret = toFOLD_uvchr(c, u, &len);
2230         av_push(av, newSVuv(ret));
2231
2232         utf8 = newSVpvn((char *) u, len);
2233         SvUTF8_on(utf8);
2234         av_push(av, utf8);
2235
2236         av_push(av, newSVuv(len));
2237         RETVAL = av;
2238     OUTPUT:
2239         RETVAL
2240
2241 #endif
2242
2243 UV
2244 LATIN1_TO_NATIVE(cp)
2245         UV cp
2246         CODE:
2247                 if (cp > 255) RETVAL= cp;
2248                 else RETVAL= LATIN1_TO_NATIVE(cp);
2249         OUTPUT:
2250                 RETVAL
2251
2252 UV
2253 NATIVE_TO_LATIN1(cp)
2254         UV cp
2255         CODE:
2256                 RETVAL= NATIVE_TO_LATIN1(cp);
2257         OUTPUT:
2258                 RETVAL
2259
2260 STRLEN
2261 av_tindex(av)
2262         SV *av
2263         CODE:
2264                 RETVAL = av_tindex((AV*)SvRV(av));
2265         OUTPUT:
2266                 RETVAL
2267
2268 STRLEN
2269 av_top_index(av)
2270         SV *av
2271         CODE:
2272                 RETVAL = av_top_index((AV*)SvRV(av));
2273         OUTPUT:
2274                 RETVAL
2275
2276 =tests plan => 22270
2277
2278 use vars qw($my_sv @my_av %my_hv);
2279
2280 ok(&Devel::PPPort::boolSV(1));
2281 ok(!&Devel::PPPort::boolSV(0));
2282
2283 $_ = "Fred";
2284 ok(&Devel::PPPort::DEFSV(), "Fred");
2285 ok(&Devel::PPPort::UNDERBAR(), "Fred");
2286
2287 if ("$]" >= 5.009002 && "$]" < 5.023 && "$]" < 5.023004) {
2288   eval q{
2289     no warnings "deprecated";
2290     no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
2291     my $_ = "Tony";
2292     ok(&Devel::PPPort::DEFSV(), "Fred");
2293     ok(&Devel::PPPort::UNDERBAR(), "Tony");
2294   };
2295 }
2296 else {
2297   ok(1);
2298   ok(1);
2299 }
2300
2301 my @r = &Devel::PPPort::DEFSV_modify();
2302
2303 ok(@r == 3);
2304 ok($r[0], 'Fred');
2305 ok($r[1], 'DEFSV');
2306 ok($r[2], 'Fred');
2307
2308 ok(&Devel::PPPort::DEFSV(), "Fred");
2309
2310 eval { 1 };
2311 ok(!&Devel::PPPort::ERRSV());
2312 eval { cannot_call_this_one() };
2313 ok(&Devel::PPPort::ERRSV());
2314
2315 ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
2316 ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
2317 ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
2318
2319 $my_sv = 1;
2320 ok(&Devel::PPPort::get_sv('my_sv', 0));
2321 ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
2322 ok(&Devel::PPPort::get_sv('not_my_sv', 1));
2323
2324 @my_av = (1);
2325 ok(&Devel::PPPort::get_av('my_av', 0));
2326 ok(!&Devel::PPPort::get_av('not_my_av', 0));
2327 ok(&Devel::PPPort::get_av('not_my_av', 1));
2328
2329 %my_hv = (a=>1);
2330 ok(&Devel::PPPort::get_hv('my_hv', 0));
2331 ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
2332 ok(&Devel::PPPort::get_hv('not_my_hv', 1));
2333
2334 sub my_cv { 1 };
2335 ok(&Devel::PPPort::get_cv('my_cv', 0));
2336 ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
2337 ok(&Devel::PPPort::get_cv('not_my_cv', 1));
2338
2339 ok(Devel::PPPort::dXSTARG(42), 43);
2340 ok(Devel::PPPort::dAXMARK(4711), 4710);
2341
2342 ok(Devel::PPPort::prepush(), 42);
2343
2344 ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
2345 ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
2346
2347 ok(Devel::PPPort::PERL_ABS(42), 42);
2348 ok(Devel::PPPort::PERL_ABS(-13), 13);
2349
2350 ok(Devel::PPPort::SVf(42), "$]" >= 5.004 ? '[42]' : '42');
2351 ok(Devel::PPPort::SVf('abc'), "$]" >= 5.004 ? '[abc]' : 'abc');
2352
2353 ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
2354
2355 ok(&Devel::PPPort::ptrtests(), 63);
2356
2357 ok(&Devel::PPPort::OpSIBLING_tests(), 0);
2358
2359 if ("$]" >= 5.009000) {
2360   eval q{
2361     ok(&Devel::PPPort::check_HeUTF8("hello"), "norm");
2362     ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
2363   };
2364 } else {
2365   ok(1, 1);
2366   ok(1, 1);
2367 }
2368
2369 @r = &Devel::PPPort::check_c_array();
2370 ok($r[0], 4);
2371 ok($r[1], "13");
2372
2373 ok(!Devel::PPPort::SvRXOK(""));
2374 ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
2375
2376 if ("$]" < 5.005) {
2377         skip 'no qr// objects in this perl', 0;
2378         skip 'no qr// objects in this perl', 0;
2379 } else {
2380         my $qr = eval 'qr/./';
2381         ok(Devel::PPPort::SvRXOK($qr));
2382         ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise"));
2383 }
2384
2385 ok( Devel::PPPort::NATIVE_TO_LATIN1(0xB6) == 0xB6);
2386 ok( Devel::PPPort::NATIVE_TO_LATIN1(0x1) == 0x1);
2387 ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("A")) == 0x41);
2388 ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("0")) == 0x30);
2389
2390 ok( Devel::PPPort::LATIN1_TO_NATIVE(0xB6) == 0xB6);
2391 if (ord("A") == 65) {
2392     ok( Devel::PPPort::LATIN1_TO_NATIVE(0x41) == 0x41);
2393     ok( Devel::PPPort::LATIN1_TO_NATIVE(0x30) == 0x30);
2394 }
2395 else {
2396     ok( Devel::PPPort::LATIN1_TO_NATIVE(0x41) == 0xC1);
2397     ok( Devel::PPPort::LATIN1_TO_NATIVE(0x30) == 0xF0);
2398 }
2399
2400 ok(  Devel::PPPort::isALNUMC_L1(ord("5")));
2401 ok(  Devel::PPPort::isALNUMC_L1(0xFC));
2402 ok(! Devel::PPPort::isALNUMC_L1(0xB6));
2403
2404 ok(  Devel::PPPort::isOCTAL(ord("7")));
2405 ok(! Devel::PPPort::isOCTAL(ord("8")));
2406
2407 ok(  Devel::PPPort::isOCTAL_A(ord("0")));
2408 ok(! Devel::PPPort::isOCTAL_A(ord("9")));
2409
2410 ok(  Devel::PPPort::isOCTAL_L1(ord("2")));
2411 ok(! Devel::PPPort::isOCTAL_L1(ord("8")));
2412
2413 # For the other properties, we test every code point from 0.255, and a
2414 # smattering of higher ones.  First populate a hash with keys like '65:ALPHA'
2415 # to indicate that the code point there is alphabetic
2416 my $i;
2417 my %types;
2418 for $i (0x41..0x5A, 0x61..0x7A, 0xAA, 0xB5, 0xBA, 0xC0..0xD6, 0xD8..0xF6,
2419         0xF8..0x101)
2420 {
2421     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2422     $types{"$native:ALPHA"} = 1;
2423     $types{"$native:ALPHANUMERIC"} = 1;
2424     $types{"$native:IDFIRST"} = 1;
2425     $types{"$native:IDCONT"} = 1;
2426     $types{"$native:PRINT"} = 1;
2427     $types{"$native:WORDCHAR"} = 1;
2428 }
2429 for $i (0x30..0x39, 0x660, 0xFF19) {
2430     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2431     $types{"$native:ALPHANUMERIC"} = 1;
2432     $types{"$native:DIGIT"} = 1;
2433     $types{"$native:IDCONT"} = 1;
2434     $types{"$native:WORDCHAR"} = 1;
2435     $types{"$native:GRAPH"} = 1;
2436     $types{"$native:PRINT"} = 1;
2437     $types{"$native:XDIGIT"} = 1 if $i < 255 || ($i >= 0xFF10 && $i <= 0xFF19);
2438 }
2439
2440 for $i (0..0x7F) {
2441     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2442     $types{"$native:ASCII"} = 1;
2443 }
2444 for $i (0..0x1f, 0x7F..0x9F) {
2445     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2446     $types{"$native:CNTRL"} = 1;
2447 }
2448 for $i (0x21..0x7E, 0xA1..0x101, 0x660) {
2449     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2450     $types{"$native:GRAPH"} = 1;
2451     $types{"$native:PRINT"} = 1;
2452 }
2453 for $i (0x09, 0x20, 0xA0) {
2454     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2455     $types{"$native:BLANK"} = 1;
2456     $types{"$native:SPACE"} = 1;
2457     $types{"$native:PSXSPC"} = 1;
2458     $types{"$native:PRINT"} = 1 if $i > 0x09;
2459 }
2460 for $i (0x09..0x0D, 0x85, 0x2029) {
2461     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2462     $types{"$native:SPACE"} = 1;
2463     $types{"$native:PSXSPC"} = 1;
2464 }
2465 for $i (0x41..0x5A, 0xC0..0xD6, 0xD8..0xDE, 0x100) {
2466     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2467     $types{"$native:UPPER"} = 1;
2468     $types{"$native:XDIGIT"} = 1 if $i < 0x47;
2469 }
2470 for $i (0x61..0x7A, 0xAA, 0xB5, 0xBA, 0xDF..0xF6, 0xF8..0xFF, 0x101) {
2471     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2472     $types{"$native:LOWER"} = 1;
2473     $types{"$native:XDIGIT"} = 1 if $i < 0x67;
2474 }
2475 for $i (0x21..0x2F, 0x3A..0x40, 0x5B..0x60, 0x7B..0x7E, 0xB6, 0xA1, 0xA7, 0xAB,
2476         0xB7, 0xBB, 0xBF, 0x5BE)
2477 {
2478     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2479     $types{"$native:PUNCT"} = 1;
2480     $types{"$native:GRAPH"} = 1;
2481     $types{"$native:PRINT"} = 1;
2482 }
2483
2484 $i = ord('_');
2485 $types{"$i:WORDCHAR"} = 1;
2486 $types{"$i:IDFIRST"} = 1;
2487 $types{"$i:IDCONT"} = 1;
2488
2489 # Now find all the unique code points included above.
2490 my %code_points_to_test;
2491 my $key;
2492 for $key (keys %types) {
2493     $key =~ s/:.*//;
2494     $code_points_to_test{$key} = 1;
2495 }
2496
2497 # And test each one
2498 for $i (sort { $a <=> $b } keys %code_points_to_test) {
2499     my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
2500     my $hex = sprintf("0x%02X", $native);
2501
2502     # And for each code point test each of the classes
2503     my $class;
2504     for $class (qw(ALPHA ALPHANUMERIC ASCII BLANK CNTRL DIGIT GRAPH IDCONT
2505                    IDFIRST LOWER PRINT PSXSPC PUNCT SPACE UPPER WORDCHAR
2506                    XDIGIT))
2507     {
2508         if ($i < 256) {  # For the ones that can fit in a byte, test each of
2509                          #three macros.
2510             my $suffix;
2511             for $suffix ("", "_A", "_L1", "_uvchr") {
2512                 my $should_be = ($i > 0x7F && $suffix !~ /_(uvchr|L1)/)
2513                                 ? 0     # Fail on non-ASCII unless unicode
2514                                 : ($types{"$native:$class"} || 0);
2515                 if ("$]" < 5.006 && $suffix eq '_uvchr') {
2516                     skip("No UTF-8 on this perl", 0);
2517                     next;
2518                 }
2519
2520                 my $eval_string = "Devel::PPPort::is${class}$suffix($hex)";
2521                 my $is = eval $eval_string || 0;
2522                 die "eval 'For $i: $eval_string' gave $@" if $@;
2523                 ok($is, $should_be, "'$eval_string'");
2524             }
2525         }
2526
2527         # For all code points, test the '_utf8' macros
2528         if ("$]" < 5.006) {
2529             skip("No UTF-8 on this perl", 0);
2530             if ($i > 255) {
2531                 skip("No UTF-8 on this perl", 0);
2532             }
2533         }
2534         else {
2535             my $utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($i);
2536             if ("$]" < 5.007 && $native > 255) {
2537                 skip("Perls earlier than 5.7 give wrong answers for above Latin1 code points", 0);
2538             }
2539             elsif ("$]" <= 5.011003 && $native == 0x2029 && ($class eq 'PRINT' || $class eq 'GRAPH')) {
2540                 skip("Perls earlier than 5.11.3 considered high space characters as isPRINT and isGRAPH", 0);
2541             }
2542             else {
2543
2544                 my $should_be = $types{"$native:$class"} || 0;
2545                 my $eval_string = "Devel::PPPort::is${class}_utf8_safe(\"$utf8\", 0)";
2546                 my $is = eval $eval_string || 0;
2547                 die "eval 'For $i, $eval_string' gave $@" if $@;
2548                 ok($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
2549             }
2550
2551             # And for the high code points, test that a too short malformation (the
2552             # -1) causes it to fail
2553             if ($i > 255) {
2554                 if ("$]" >= 5.025009) {
2555                     skip("Prints an annoying error message that khw doesn't know how to easily suppress", 0);
2556                 }
2557                 else {
2558                     my $eval_string = "Devel::PPPort::is${class}_utf8_safe(\"$utf8\", -1)";
2559                     my $is = eval "no warnings; $eval_string" || 0;
2560                     die "eval '$eval_string' gave $@" if $@;
2561                     ok($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
2562                 }
2563             }
2564         }
2565     }
2566 }
2567
2568 my %case_changing = ( 'LOWER' => [ [ ord('A'), ord('a') ],
2569                                    [ 0xC0, 0xE0 ],
2570                                    [ 0x100, 0x101 ],
2571                                  ],
2572                       'FOLD'  => [ [ ord('C'), ord('c') ],
2573                                    [ 0xC0, 0xE0 ],
2574                                    [ 0x104, 0x105 ],
2575                                    [ 0xDF, 'ss' ],
2576                                  ],
2577                       'UPPER' => [ [ ord('a'),ord('A'),  ],
2578                                    [ 0xE0, 0xC0 ],
2579                                    [ 0x101, 0x100 ],
2580                                    [ 0xDF, 'SS' ],
2581                                  ],
2582                       'TITLE' => [ [ ord('c'),ord('C'),  ],
2583                                    [ 0xE2, 0xC2 ],
2584                                    [ 0x103, 0x102 ],
2585                                    [ 0xDF, 'Ss' ],
2586                                  ],
2587                     );
2588
2589 my $way_too_early_msg = 'UTF-8 not implemented on this perl';
2590
2591 my $name;
2592 for $name (keys %case_changing) {
2593     my @code_points_to_test = @{$case_changing{$name}};
2594     my $unchanged;
2595     for $unchanged (@code_points_to_test) {
2596         my @pair = @$unchanged;
2597         my $original = $pair[0];
2598         my $changed = $pair[1];
2599         my $utf8_changed = $changed;
2600         my $is_cp = $utf8_changed =~ /^\d+$/;
2601         my $should_be_bytes;
2602         if ("$]" >= 5.006000) {
2603             if ($is_cp) {
2604                 $utf8_changed = Devel::PPPort::uvoffuni_to_utf8($changed);
2605                 $should_be_bytes = Devel::PPPort::UTF8_SAFE_SKIP($utf8_changed, 0);
2606             }
2607             else {
2608                 die("Test currently doesn't work for non-ASCII multi-char case changes") if $utf8_changed =~ /[[:^ascii:]]/;
2609                 $should_be_bytes = length $utf8_changed;
2610             }
2611         }
2612
2613         my $fcn = "to${name}_uvchr";
2614         my $skip = "";
2615
2616         if ("$]" < 5.006000) {
2617             $skip = $way_too_early_msg;
2618         }
2619         elsif (! $is_cp) {
2620             $skip = "Can't do uvchr on a multi-char string";
2621         }
2622         if ($skip) {
2623             for (1..4) {
2624                 skip $skip, 0;
2625             }
2626         }
2627         else {
2628             if ($is_cp) {
2629                 $utf8_changed = Devel::PPPort::uvoffuni_to_utf8($changed);
2630                 $should_be_bytes = Devel::PPPort::UTF8_SAFE_SKIP($utf8_changed, 0);
2631             }
2632             else {
2633                 die("Test currently doesn't work for non-ASCII multi-char case changes") if $utf8_changed =~ /[[:^ascii:]]/;
2634                 $should_be_bytes = length $utf8_changed;
2635             }
2636
2637             my $ret = eval "Devel::PPPort::$fcn($original)";
2638             my $fail = $@;  # Have to save $@, as it gets destroyed
2639             ok ($fail, "", "$fcn($original) didn't fail");
2640             my $first = ("$]" != 5.006000)
2641                         ? substr($utf8_changed, 0, 1)
2642                         : $utf8_changed, 0, 1;
2643             ok($ret->[0], ord $first,
2644                "ord of $fcn($original) is $changed");
2645             ok($ret->[1], $utf8_changed,
2646                "UTF-8 of of $fcn($original) is correct");
2647             ok($ret->[2], $should_be_bytes,
2648                "Length of $fcn($original) is $should_be_bytes");
2649         }
2650
2651         my $truncate;
2652         for $truncate (0..2) {
2653             my $skip;
2654             if ("$]" < 5.006000) {
2655                 $skip = 'UTF-8 not implemented on this perl';
2656             }
2657             elsif (! $is_cp && "$]" < 5.007003) {
2658                 $skip = "Multi-character case change not implemented until 5.7.3";
2659             }
2660             elsif ($truncate == 2 && "$]" > 5.025008) {
2661                 $skip = "Zero length inputs cause assertion failure; test dies in modern perls";
2662             }
2663             elsif ($truncate > 0 && length $changed > 1) {
2664                 $skip = "Don't test shortened multi-char case changes";
2665             }
2666             elsif ($truncate > 0 && Devel::PPPort::UVCHR_IS_INVARIANT($original)) {
2667                 $skip = "Don't try to test shortened single bytes";
2668             }
2669             if ($skip) {
2670                 for (1..4) {
2671                     skip $skip, 0;
2672                 }
2673             }
2674             else {
2675                 my $fcn = "to${name}_utf8_safe";
2676                 my $utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($original);
2677                 my $real_truncate = ($truncate < 2)
2678                                     ? $truncate : $should_be_bytes;
2679                 my $eval_string = "Devel::PPPort::$fcn(\"$utf8\", $real_truncate)";
2680                 my $ret = eval "no warnings; $eval_string" || 0;
2681                 my $fail = $@;  # Have to save $@, as it gets destroyed
2682                 if ($truncate == 0) {
2683                     ok ($fail, "", "Didn't fail on full length input");
2684                     my $first = ("$]" != 5.006000)
2685                                 ? substr($utf8_changed, 0, 1)
2686                                 : $utf8_changed, 0, 1;
2687                     ok($ret->[0], ord $first,
2688                        "ord of $fcn($original) is $changed");
2689                     ok($ret->[1], $utf8_changed,
2690                        "UTF-8 of of $fcn($original) is correct");
2691                     ok($ret->[2], $should_be_bytes,
2692                     "Length of $fcn($original) is $should_be_bytes");
2693                 }
2694                 else {
2695                     ok ($fail, eval 'qr/Malformed UTF-8 character/',
2696                         "Gave appropriate error for short char: $original");
2697                     for (1..3) {
2698                         skip("Expected failure means remaining tests for"
2699                            . " this aren't relevant", 0);
2700                     }
2701                 }
2702             }
2703         }
2704     }
2705 }
2706
2707 ok(&Devel::PPPort::av_top_index([1,2,3]), 2);
2708 ok(&Devel::PPPort::av_tindex([1,2,3,4]), 3);