view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

 * isPUNCT_LC_utf8_safe, isSPACE_LC_utf8_safe, isUPPER_LC_utf8_safe,
 * isWORDCHAR_LC_utf8_safe, isWORDCHAR_LC_utf8_safe, isXDIGIT_LC_utf8_safe,
 * isALPHANUMERIC_uvchr, isALPHA_uvchr, isASCII_uvchr, isBLANK_uvchr,
 * isCNTRL_uvchr, isDIGIT_uvchr, isGRAPH_uvchr, isIDCONT_uvchr,
 * isIDFIRST_uvchr, isLOWER_uvchr, isPRINT_uvchr, isPSXSPC_uvchr,
 * isPUNCT_uvchr, isSPACE_uvchr, isUPPER_uvchr, isWORDCHAR_uvchr,
 * isWORDCHAR_uvchr, isXDIGIT_uvchr
 *
 * The UTF-8 handling is buggy in early Perls, and this can give inaccurate
 * results for code points above 0xFF, until the implementation started
 * settling down in 5.12 and 5.14 */

#endif

#define D_PPP_TOO_SHORT_MSG  "Malformed UTF-8 character starting with:"      \
                             " \\x%02x (too short; %d bytes available, need" \
                             " %d)\n"
/* Perls starting here had a new API which handled multi-character results */
#if (PERL_BCDVERSION >= 0x5007003)
#ifndef toLOWER_uvchr
#  define toLOWER_uvchr(c, s, l)         UNI_TO_NATIVE(to_uni_lower(NATIVE_TO_UNI(c), s, l))
#endif

#ifndef toUPPER_uvchr
#  define toUPPER_uvchr(c, s, l)         UNI_TO_NATIVE(to_uni_upper(NATIVE_TO_UNI(c), s, l))
#endif

#ifndef toTITLE_uvchr
#  define toTITLE_uvchr(c, s, l)         UNI_TO_NATIVE(to_uni_title(NATIVE_TO_UNI(c), s, l))
#endif

#ifndef toFOLD_uvchr
#  define toFOLD_uvchr(c, s, l)          UNI_TO_NATIVE(to_uni_fold( NATIVE_TO_UNI(c), s, l))
#endif

#  if (PERL_BCDVERSION != 0x5015006)     /* Just this version is broken */

      /* Prefer the macro to the function */
#    if defined toLOWER_utf8
#      define D_PPP_TO_LOWER_CALLEE(s,r,l)    toLOWER_utf8(s,r,l)
#    else
#      define D_PPP_TO_LOWER_CALLEE(s,r,l)    to_utf8_lower(s,r,l)
#    endif
#    if defined toTITLE_utf8
#      define D_PPP_TO_TITLE_CALLEE(s,r,l)    toTITLE_utf8(s,r,l)
#    else
#      define D_PPP_TO_TITLE_CALLEE(s,r,l)    to_utf8_title(s,r,l)
#    endif
#    if defined toUPPER_utf8
#      define D_PPP_TO_UPPER_CALLEE(s,r,l)    toUPPER_utf8(s,r,l)
#    else
#      define D_PPP_TO_UPPER_CALLEE(s,r,l)    to_utf8_upper(s,r,l)
#    endif
#    if defined toFOLD_utf8
#      define D_PPP_TO_FOLD_CALLEE(s,r,l)     toFOLD_utf8(s,r,l)
#    else
#      define D_PPP_TO_FOLD_CALLEE(s,r,l)     to_utf8_fold(s,r,l)
#    endif
#  else     /* Below is 5.15.6, which failed to make the macros available
#              outside of core, so we have to use the 'Perl_' form.  khw
#              decided it was easier to just handle this case than have to
#              document the exception, and make an exception in the tests below
#              */
#    define D_PPP_TO_LOWER_CALLEE(s,r,l)                                    \
                        Perl__to_utf8_lower_flags(aTHX_ s, r, l, 0, NULL)
#    define D_PPP_TO_TITLE_CALLEE(s,r,l)                                    \
                        Perl__to_utf8_title_flags(aTHX_ s, r, l, 0, NULL)
#    define D_PPP_TO_UPPER_CALLEE(s,r,l)                                    \
                        Perl__to_utf8_upper_flags(aTHX_ s, r, l, 0, NULL)
#    define D_PPP_TO_FOLD_CALLEE(s,r,l)                                     \
            Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
#  endif

/* The actual implementation of the backported macros.  If too short, croak,
 * otherwise call the original that doesn't have an upper limit parameter */
#  define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l)                        \
    (((((e) - (s)) <= 0)                                                    \
         /* We could just do nothing, but modern perls croak */             \
      ? (croak("Attempting case change on zero length string"),             \
         0) /* So looks like it returns something, and will compile */      \
      : ((e) - (s)) < UTF8SKIP(s))                                          \
        ? (croak(D_PPP_TOO_SHORT_MSG,                                       \
                               s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
           0)                                                               \
        : D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
#  define toUPPER_utf8_safe(s,e,r,l)     \
                        D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif

#ifndef toLOWER_utf8_safe
#  define toLOWER_utf8_safe(s,e,r,l)     \
                        D_PPP_GENERIC_MULTI_ARG_TO(LOWER,s,e,r,l)
#endif

#ifndef toTITLE_utf8_safe
#  define toTITLE_utf8_safe(s,e,r,l)     \
                        D_PPP_GENERIC_MULTI_ARG_TO(TITLE,s,e,r,l)
#endif

#ifndef toFOLD_utf8_safe
#  define toFOLD_utf8_safe(s,e,r,l)      \
                        D_PPP_GENERIC_MULTI_ARG_TO(FOLD,s,e,r,l)
#endif

#elif (PERL_BCDVERSION >= 0x5006000)

/* Here we have UTF-8 support, but using the original API where the case
 * changing functions merely returned the changed code point; hence they
 * couldn't handle multi-character results. */

#  ifdef uvchr_to_utf8
#    define D_PPP_UV_TO_UTF8 uvchr_to_utf8
#  else
#    define D_PPP_UV_TO_UTF8 uv_to_utf8
#  endif

   /* Get the utf8 of the case changed value, and store its length; then have
    * to re-calculate the changed case value in order to return it */
#  define D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(name, c, s, l)                  \
        (*(l) = (D_PPP_UV_TO_UTF8(s,                                        \