dist/Devel-PPPort/parts/inc/misc

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