Add utf8_hop_back_overshoot()

This is like plain utf8_hop_back() except it returns how many
characters the request would have overshot the edge if it had been
allowed to go beyond the edge.

This allows the caller to do error handling.

The code has to be changed to be more careful (than before this commit)
with counting the actual number of characters consumed in the hop.

Author: khwilliamson

embed.fnc

@@ -3613,9 +3613,14 @@ ARdip	|IV	|utf8_distance	|NN const U8 *a 			\
 				|NN const U8 *b
 ARTdip	|U8 *	|utf8_hop	|NN const U8 *s 			\
 				|SSize_t off
-ARTdip	|U8 *	|utf8_hop_back	|NN const U8 *s 			\
+ARTdmp	|U8 *	|utf8_hop_back	|NN const U8 *s 			\
 				|SSize_t off				\
-				|NN const U8 *start
+				|NN const U8 * const start
+ARTdip	|U8 *	|utf8_hop_back_overshoot				\
+				|NN const U8 *s 			\
+				|SSize_t off				\
+				|NN const U8 * const start		\
+				|NULLOK SSize_t *remaining
 ARTdip	|U8 *	|utf8_hop_forward					\
 				|NN const U8 *s 			\
 				|SSize_t off				\

embed.h

@@ -787,6 +787,7 @@
 # define utf8_distance(a,b)                     Perl_utf8_distance(aTHX_ a,b)
 # define utf8_hop                               Perl_utf8_hop
 # define utf8_hop_back                          Perl_utf8_hop_back
+# define utf8_hop_back_overshoot                Perl_utf8_hop_back_overshoot
 # define utf8_hop_forward                       Perl_utf8_hop_forward
 # define utf8_hop_safe                          Perl_utf8_hop_safe
 # define utf8_length(a,b)                       Perl_utf8_length(aTHX_ a,b)

inline.h

@@ -2708,28 +2708,48 @@ Perl_utf8_hop_forward(const U8 *s, SSize_t off, const U8 *end)
 }
 
 /*
-=for apidoc utf8_hop_back
-
-Return the UTF-8 pointer C<s> displaced by up to C<off> characters,
-backward.  C<s> does not need to be pointing to the starting byte of a
-character.  If it isn't, one count of C<off> will be used up to get to that
-start.
-
-C<off> must be non-positive.
-
-C<s> must be after or equal to C<start>.
-
-When moving backward it will not move before C<start>.
-
-Will not exceed this limit even if the string is not valid "UTF-8".
+=for apidoc      utf8_hop_back
+=for apidoc_item utf8_hop_back_overshoot
+
+These each take as input a string encoded as UTF-8 which starts at C<start>,
+and a position into it given by C<s>, and return the position within it that is
+C<s> displaced by up to C<off> characters backwards.
+
+If there are fewer than C<off> characters between C<start> and C<s>, the
+functions return C<start>.
+
+The functions differ in that C<utf8_hop_back_overshoot> can return how many
+characters C<off> beyond the edge the request was for.  When its parameter,
+C<&remaining>, is not NULL, the function stores into it the count of the
+excess; zero if the request was completely fulfilled.  The actual number of
+characters that were displaced can then be calculated as S<C<off - remaining>>.
+This function acts identically to plain C<utf8_hop_back> when this parameter is
+NULL.
+
+C<s> does not need to be pointing to the starting byte of a character.  If it
+isn't, one count of C<off> will be used up to get to that start.
+
+C<off> must be non-positive, and if zero, no action is taken; C<s> is returned
+unchanged.  That it otherwise must be negative means that the earlier
+description is a lie, to avoid burdening you with this detail too soon.  An
+C<off> of C<-2> means to displace two characters backwards, so the displacement
+is actually the absolute value of C<off>.  C<remaining> will also be
+non-positive.  If there was only one character between C<start> and C<s>, and a
+displacement of C<-2> was requested, C<remaining> would be set to C<-1>.  The
+subtraction formula works, yielding the result that only C<-1> character was
+displaced.
 
 =cut
 */
 
+# define Perl_utf8_hop_back(          s, off, start)            \
+         Perl_utf8_hop_back_overshoot(s, off, start, NULL)
+
 PERL_STATIC_INLINE U8 *
-Perl_utf8_hop_back(const U8 *s, SSize_t off, const U8 *start)
+Perl_utf8_hop_back_overshoot(const U8 *s, SSize_t off,
+                             const U8 * const start, SSize_t *remaining)
 {
-    PERL_ARGS_ASSERT_UTF8_HOP_BACK;
+    PERL_ARGS_ASSERT_UTF8_HOP_BACK_OVERSHOOT;
     assert(start <= s);
     assert(off <= 0);
 
@@ -2740,10 +2760,18 @@ Perl_utf8_hop_back(const U8 *s, SSize_t off, const U8 *start)
      * moved is large, and core perl doesn't currently move more than a few
      * characters at a time.  You can reinstate it if it does become
      * advantageous. */
-    while (off++ && s > start) {
-        do {
+    while (off < 0 && s > start) {
+        do {    /* Find the beginning of this character */
             s--;
-        } while (s > start && UTF8_IS_CONTINUATION(*s));
+            if (! UTF8_IS_CONTINUATION(*s)) {
+                off++;
+                break;
+            }
+        } while (s > start);
+    }
+
+    if (remaining) {
+        *remaining = off;
     }
 
     GCC_DIAG_IGNORE(-Wcast-qual)