Devel-PPPort

 view release on metacpan or  search on metacpan

parts/inc/utf8  view on Meta::CPAN

                                      : D_PPP_MIN(((e) - (s)), UTF8SKIP(s))))

__UNDEFINED__ UTF8_CHK_SKIP(s)                                                  \
    (s[0] == '\0' ? 1 : ((U8) D_PPP_MIN(my_strnlen((char *) (s), UTF8SKIP(s)),  \
                                      UTF8SKIP(s))))
/* UTF8_CHK_SKIP depends on my_strnlen */
__UNDEFINED__ UTF8_SKIP(s)  UTF8SKIP(s)
#endif

#if 'A' == 65
__UNDEFINED__ UTF8_IS_INVARIANT(c)   isASCII(c)
#else
__UNDEFINED__ UTF8_IS_INVARIANT(c)  (isASCII(c) || isCNTRL_L1(c))
#endif

__UNDEFINED__ UVCHR_IS_INVARIANT(c)  UTF8_IS_INVARIANT(c)

#ifdef UVCHR_IS_INVARIANT
#  if 'A' != 65 || UVSIZE < 8
     /* 32 bit platform, which includes UTF-EBCDIC on the releases this is
      * backported to */
#    define D_PPP_UVCHR_SKIP_UPPER(c) 7
#  else
#    define D_PPP_UVCHR_SKIP_UPPER(c)                                       \
        (((WIDEST_UTYPE) (c)) <                                             \
         (((WIDEST_UTYPE) 1) << (6 * D_PPP_BYTE_INFO_BITS)) ? 7 : 13)
#  endif

__UNDEFINED__ UVCHR_SKIP(c)                                                     \
          UVCHR_IS_INVARIANT(c)                                          ? 1 :  \
          (WIDEST_UTYPE) (c) < (32 * (1U << (    D_PPP_BYTE_INFO_BITS))) ? 2 :  \
          (WIDEST_UTYPE) (c) < (16 * (1U << (2 * D_PPP_BYTE_INFO_BITS))) ? 3 :  \
          (WIDEST_UTYPE) (c) < ( 8 * (1U << (3 * D_PPP_BYTE_INFO_BITS))) ? 4 :  \
          (WIDEST_UTYPE) (c) < ( 4 * (1U << (4 * D_PPP_BYTE_INFO_BITS))) ? 5 :  \
          (WIDEST_UTYPE) (c) < ( 2 * (1U << (5 * D_PPP_BYTE_INFO_BITS))) ? 6 :  \
          D_PPP_UVCHR_SKIP_UPPER(c)
#endif

#ifdef is_ascii_string
__UNDEFINED__ is_invariant_string(s,l) is_ascii_string(s,l)
__UNDEFINED__ is_utf8_invariant_string(s,l) is_ascii_string(s,l)

/* Hint: is_ascii_string, is_invariant_string
   is_utf8_invariant_string() does the same thing and is preferred because its
   name is more accurate as to what it does */
#endif

#ifdef ibcmp_utf8
__UNDEFINED__ foldEQ_utf8(s1,pe1,l1,u1,s2,pe2,l2,u2)                            \
                                cBOOL(! ibcmp_utf8(s1,pe1,l1,u1,s2,pe2,l2,u2))
#endif

#if defined(is_utf8_string) && defined(UTF8SKIP)
__UNDEFINED__ isUTF8_CHAR(s, e)    (                                            \
    (e) <= (s) || ! is_utf8_string(s, UTF8_SAFE_SKIP(s, e))                     \
    ? 0                                                                         \
    : UTF8SKIP(s))
#endif

#if 'A' == 65
__UNDEFINED__ BOM_UTF8                    "\xEF\xBB\xBF"
__UNDEFINED__ REPLACEMENT_CHARACTER_UTF8  "\xEF\xBF\xBD"
#elif '^' == 95
__UNDEFINED__ BOM_UTF8                    "\xDD\x73\x66\x73"
__UNDEFINED__ REPLACEMENT_CHARACTER_UTF8  "\xDD\x73\x73\x71"
#elif '^' == 176
__UNDEFINED__ BOM_UTF8                    "\xDD\x72\x65\x72"
__UNDEFINED__ REPLACEMENT_CHARACTER_UTF8  "\xDD\x72\x72\x70"
#else
#  error Unknown character set
#endif

#if { VERSION < 5.35.10 }
        /* Versions prior to 5.31.4 accepted things that are now considered
         * malformations, and didn't return -1 on error with warnings enabled.
         * Versions before 5.35.10 dereferenced empty input without checking */
#  undef utf8_to_uvchr_buf
#endif

/* This implementation brings modern, generally more restricted standards to
 * utf8_to_uvchr_buf.  Some of these are security related, and clearly must
 * be done.  But its arguable that the others need not, and hence should not.
 * The reason they're here is that a module that intends to play with the
 * latest perls should be able to work the same in all releases.  An example is
 * that perl no longer accepts any UV for a code point, but limits them to
 * IV_MAX or below.  This is for future internal use of the larger code points.
 * If it turns out that some of these changes are breaking code that isn't
 * intended to work with modern perls, the tighter restrictions could be
 * relaxed.  khw thinks this is unlikely, but has been wrong in the past. */

/* 5.6.0 is the first release with UTF-8, and we don't implement this function
 * there due to its likely lack of still being in use, and the underlying
 * implementation is very different from later ones, without the later
 * safeguards, so would require extra work to deal with */
#if { VERSION >= 5.6.1 } && ! defined(utf8_to_uvchr_buf)
   /* Choose which underlying implementation to use.  At least one must be
    * present or the perl is too early to handle this function */
#  if defined(utf8n_to_uvchr) || defined(utf8_to_uvchr) || defined(utf8_to_uv)
#    if defined(utf8n_to_uvchr)   /* This is the preferred implementation */
#      define D_PPP_utf8_to_uvchr_buf_callee utf8n_to_uvchr
#    elif /* Must be at least 5.6.1 from #if above;                             \
             If have both regular and _simple, regular has all args */          \
          defined(utf8_to_uv) && defined(utf8_to_uv_simple)
#      define D_PPP_utf8_to_uvchr_buf_callee utf8_to_uv
#    elif defined(utf8_to_uvchr)  /* The below won't work well on error input */
#      define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags)          \
                                            utf8_to_uvchr((U8 *)(s), (retlen))
#    else
#      define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags)          \
                                            utf8_to_uv((U8 *)(s), (retlen))
#    endif
#  endif

#  if { NEED utf8_to_uvchr_buf }

UV
utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
{
#    if { VERSION >= 5.31.4 }   /* But from above, must be < 5.35.10 */
#      if { VERSION != 5.35.9 }

    /* Versions less than 5.35.9 could dereference s on zero length, so
     * pass it something where no harm comes from that. */
    if (send <= s) s = send = (U8 *) "?";
    return Perl_utf8_to_uvchr_buf_helper(aTHX_ s, send, retlen);

#      else /* Below is 5.35.9, which also works on non-empty input, but



( run in 3.618 seconds using v1.01-cache-2.11-cpan-5e09290becf )