Add new function utf8_from_bytes_loc()

This is currently undocumented externally, so we can change the API if
needed.

This is like utf8_from_bytes(), but in the case of not being able to
convert the whole string, it converts the initial substring that is
convertible, and tells you where it had to stop.

diff --git a/embed.fnc b/embed.fnc
index fd59c72..c8576af 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1798,7 +1798,11 @@ AipdRn   |U8*    |utf8_hop_safe  |NN const U8 *s|SSize_t off|NN const U8 *start|NN con
 ApMd   |U8*    |utf8_to_bytes  |NN U8 *s|NN STRLEN *lenp
 Apd    |int    |bytes_cmp_utf8 |NN const U8 *b|STRLEN blen|NN const U8 *u \
                                |STRLEN ulen
-ApMd   |U8*    |bytes_from_utf8|NN const U8 *s|NN STRLEN *lenp|NN bool *is_utf8p
+AModp  |U8*    |bytes_from_utf8|NN const U8 *s|NN STRLEN *lenp|NN bool *is_utf8p
+AMnp   |U8*    |bytes_from_utf8_loc|NN const U8 *s                         \
+                                   |NN STRLEN *lenp                        \
+                                   |NN bool *is_utf8p                      \
+                                   |NULLOK const U8 ** first_unconverted
 ApMd   |U8*    |bytes_to_utf8  |NN const U8 *s|NN STRLEN *lenp
 ApdD   |UV     |utf8_to_uvchr  |NN const U8 *s|NULLOK STRLEN *retlen
 ApdD   |UV     |utf8_to_uvuni  |NN const U8 *s|NULLOK STRLEN *retlen

diff --git a/embed.h b/embed.h
index aeec637..7cc3bbe 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -71,7 +71,7 @@
 #define block_gimme()          Perl_block_gimme(aTHX)
 #define block_start(a)         Perl_block_start(aTHX_ a)
 #define bytes_cmp_utf8(a,b,c,d)        Perl_bytes_cmp_utf8(aTHX_ a,b,c,d)
-#define bytes_from_utf8(a,b,c) Perl_bytes_from_utf8(aTHX_ a,b,c)
+#define bytes_from_utf8_loc    Perl_bytes_from_utf8_loc
 #define bytes_to_utf8(a,b)     Perl_bytes_to_utf8(aTHX_ a,b)
 #define call_argv(a,b,c)       Perl_call_argv(aTHX_ a,b,c)
 #define call_atexit(a,b)       Perl_call_atexit(aTHX_ a,b)

diff --git a/proto.h b/proto.h
index 6738544..d9c8798 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -259,6 +259,9 @@ PERL_CALLCONV int   Perl_bytes_cmp_utf8(pTHX_ const U8 *b, STRLEN blen, const U8 *
 PERL_CALLCONV U8*      Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *lenp, bool *is_utf8p);
 #define PERL_ARGS_ASSERT_BYTES_FROM_UTF8       \
        assert(s); assert(lenp); assert(is_utf8p)
+PERL_CALLCONV U8*      Perl_bytes_from_utf8_loc(const U8 *s, STRLEN *lenp, bool *is_utf8p, const U8 ** first_unconverted);
+#define PERL_ARGS_ASSERT_BYTES_FROM_UTF8_LOC   \
+       assert(s); assert(lenp); assert(is_utf8p)
 PERL_CALLCONV U8*      Perl_bytes_to_utf8(pTHX_ const U8 *s, STRLEN *lenp);
 #define PERL_ARGS_ASSERT_BYTES_TO_UTF8 \
        assert(s); assert(lenp)

diff --git a/utf8.c b/utf8.c
index d9ceef0..ebc4ad7 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1994,58 +1994,121 @@ having saved the value of C<*lenp> before the call, and subtracting the
 after-call value of C<*lenp> from it.
 
 =cut
-*/
+
+There is a macro that avoids this function call, but this is retained for
+anyone who calls it with the Perl_ prefix */
 
 U8 *
 Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *lenp, bool *is_utf8p)
 {
-    U8 *d;
-    const U8 *start = s;
-    const U8 *send;
-    Size_t count = 0;
-
     PERL_ARGS_ASSERT_BYTES_FROM_UTF8;
     PERL_UNUSED_CONTEXT;
-    if (!*is_utf8p)
-        return (U8 *)start;
-
-    /* ensure valid UTF-8 and chars < 256 before converting string */
-    for (send = s + *lenp; s < send;) {
-        if (! UTF8_IS_INVARIANT(*s)) {
-            if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, send)) {
-                return (U8 *)start;
-            }
-            count++;
-            s++;
-       }
-        s++;
-    }
 
-    *is_utf8p = FALSE;
+    return bytes_from_utf8_loc(s, lenp, is_utf8p, NULL);
+}
+
+/*
+No = here because currently externally undocumented
+for apidoc bytes_from_utf8_loc
+
+Like C<L</bytes_from_utf8>()>, but takes an extra parameter, a pointer to where
+to store the location of the first character in C<"s"> that cannot be
+converted to non-UTF8.
+
+If that parameter is C<NULL>, this function behaves identically to
+C<bytes_from_utf8>.
+
+Otherwise if C<*is_utf8p> is 0 on input, the function behaves identically to
+C<bytes_from_utf8>, except it also sets C<*first_non_downgradable> to C<NULL>.
+
+Otherwise, the function returns a newly created C<NUL>-terminated string
+containing the non-UTF8 equivalent of the convertible first portion of
+C<"s">.  C<*lenp> is set to its length, not including the terminating C<NUL>.
+If the entire input string was converted, C<*is_utf8p> is set to a FALSE value,
+and C<*first_non_downgradable> is set to C<NULL>.
+
+Otherwise, C<*first_non_downgradable> set to point to the first byte of the
+first character in the original string that wasn't converted.  C<*is_utf8p> is
+unchanged.  Note that the new string may have length 0.
+
+Another way to look at it is, if C<*first_non_downgradable> is non-C<NULL> and
+C<*is_utf8p> is TRUE, this function starts at the beginning of C<"s"> and
+converts as many characters in it as possible stopping at the first one it
+finds one that can't be converted to non-UTF-8.  C<*first_non_downgradable> is
+set to point to that.  The function returns the portion that could be converted
+in a newly created C<NUL>-terminated string, and C<*lenp> is set to its length,
+not including the terminating C<NUL>.  If the very first character in the
+original could not be converted, C<*lenp> will be 0, and the new string will
+contain just a single C<NUL>.  If the entire input string was converted,
+C<*is_utf8p> is set to FALSE and C<*first_non_downgradable> is set to C<NULL>.
+
+Upon successful return, the number of variants in the converted portion of the
+string can be computed by having saved the value of C<*lenp> before the call,
+and subtracting the after-call value of C<*lenp> from it.
+
+=cut
+
+
+*/
+
+U8 *
+Perl_bytes_from_utf8_loc(const U8 *s, STRLEN *lenp, bool *is_utf8p, const U8** first_unconverted)
+{
+    U8 *d;
+    const U8 *original = s;
+    U8 *converted_start;
+    const U8 *send = s + *lenp;
+
+    PERL_ARGS_ASSERT_BYTES_FROM_UTF8_LOC;
+
+    if (! *is_utf8p) {
+        if (first_unconverted) {
+            *first_unconverted = NULL;
+        }
+
+        return (U8 *) original;
+    }
 
-    Newx(d, (*lenp) - count + 1, U8);
+    Newx(d, (*lenp) + 1, U8);
 
-    if (LIKELY(count)) {
-        s = start; start = d;
+    converted_start = d;
         while (s < send) {
             U8 c = *s++;
             if (! UTF8_IS_INVARIANT(c)) {
-                /* Then it is two-byte encoded */
+
+            /* Then it is multi-byte encoded.  If the code point is above 0xFF,
+             * have to stop now */
+            if (UNLIKELY (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s - 1, send))) {
+                if (first_unconverted) {
+                    *first_unconverted = s - 1;
+                    goto finish_and_return;
+                }
+                else {
+                    Safefree(converted_start);
+                    return (U8 *) original;
+                }
+            }
+
                 c = EIGHT_BIT_UTF8_TO_NATIVE(c, *s);
                 s++;
             }
             *d++ = c;
         }
-        *d = '\0';
-        *lenp = d - start;
 
-        return (U8 *)start;
-    }
-    else {
-        Copy(start, d, *lenp, U8);
-        *(d + *lenp) = '\0';
-        return (U8 *)d;
+    /* Here, converted the whole of the input */
+    *is_utf8p = FALSE;
+    if (first_unconverted) {
+        *first_unconverted = NULL;
     }
+
+  finish_and_return:
+        *d = '\0';
+        *lenp = d - converted_start;
+
+    /* Trim unused space */
+    Renew(converted_start, *lenp + 1, U8);
+
+    return converted_start;
 }
 
 /*

diff --git a/utf8.h b/utf8.h
index 41db2f4..276fa29 100644 (file)
--- a/utf8.h
+++ b/utf8.h
@@ -1049,6 +1049,8 @@ is a valid UTF-8 character.
           : _is_utf8_char_helper(s, e, 0))
 
 #define is_utf8_char_buf(buf, buf_end) isUTF8_CHAR(buf, buf_end)
+#define bytes_from_utf8(s, lenp, is_utf8p)                                  \
+                            bytes_from_utf8_loc(s, lenp, is_utf8p, 0)
 
 /*