This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add is_utf8_fixed_width_buf_flags() and use it
authorKarl Williamson <khw@cpan.org>
Mon, 26 Sep 2016 04:04:08 +0000 (22:04 -0600)
committerKarl Williamson <khw@cpan.org>
Mon, 26 Sep 2016 04:24:20 +0000 (22:24 -0600)
This encodes a simple pattern that may not be immediately obvious to
someone needing it.  If you have a fixed-size buffer that is full of
purportedly UTF-8 bytes, is it valid or not?  It's easy to do, as shown
in this commit.  The file test operators -T and -B can be simpified by
using this function.

embed.fnc
embed.h
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/utf8.t
inline.h
pp_sys.c
proto.h

index 1ea0c76..168fe68 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -767,6 +767,14 @@ Anid       |bool   |is_strict_utf8_string_loclen                               \
 Anid   |bool   |is_c9strict_utf8_string_loclen                             \
                |NN const U8 *s|const STRLEN len|NULLOK const U8 **ep       \
                |NULLOK STRLEN *el
+Amnd   |bool   |is_utf8_fixed_width_buf_flags                              \
+               |NN const U8 * const s|const STRLEN len|const U32 flags
+Amnd   |bool   |is_utf8_fixed_width_buf_loc_flags                          \
+               |NN const U8 * const s|const STRLEN len                     \
+               |NULLOK const U8 **ep|const U32 flags
+Anid   |bool   |is_utf8_fixed_width_buf_loclen_flags                       \
+               |NN const U8 * const s|const STRLEN len                     \
+               |NULLOK const U8 **ep|NULLOK STRLEN *el|const U32 flags
 AmndP  |bool   |is_utf8_valid_partial_char                                 \
                |NN const U8 * const s|NN const U8 * const e
 AnidP  |bool   |is_utf8_valid_partial_char_flags                           \
diff --git a/embed.h b/embed.h
index 6485397..31d0548 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define is_utf8_char           Perl_is_utf8_char
 #define is_utf8_cntrl(a)       Perl_is_utf8_cntrl(aTHX_ a)
 #define is_utf8_digit(a)       Perl_is_utf8_digit(aTHX_ a)
+#define is_utf8_fixed_width_buf_loclen_flags   S_is_utf8_fixed_width_buf_loclen_flags
 #define is_utf8_graph(a)       Perl_is_utf8_graph(aTHX_ a)
 #define is_utf8_idcont(a)      Perl_is_utf8_idcont(aTHX_ a)
 #define is_utf8_idfirst(a)     Perl_is_utf8_idfirst(aTHX_ a)
index 5078ce9..ce94968 100644 (file)
@@ -5497,6 +5497,41 @@ test_is_c9strict_utf8_string_loclen(char *s, STRLEN len)
     OUTPUT:
         RETVAL
 
+IV
+test_is_utf8_fixed_width_buf_flags(char *s, STRLEN len, U32 flags)
+    CODE:
+        RETVAL = is_utf8_fixed_width_buf_flags((U8 *) s, len, flags);
+    OUTPUT:
+        RETVAL
+
+AV *
+test_is_utf8_fixed_width_buf_loc_flags(char *s, STRLEN len, U32 flags)
+    PREINIT:
+        AV *av;
+        const U8 * ep;
+    CODE:
+        av = newAV();
+        av_push(av, newSViv(is_utf8_fixed_width_buf_loc_flags((U8 *) s, len, &ep, flags)));
+        av_push(av, newSViv(ep - (U8 *) s));
+        RETVAL = av;
+    OUTPUT:
+        RETVAL
+
+AV *
+test_is_utf8_fixed_width_buf_loclen_flags(char *s, STRLEN len, U32 flags)
+    PREINIT:
+        AV *av;
+        STRLEN ret_len;
+        const U8 * ep;
+    CODE:
+        av = newAV();
+        av_push(av, newSViv(is_utf8_fixed_width_buf_loclen_flags((U8 *) s, len, &ep, &ret_len, flags)));
+        av_push(av, newSViv(ep - (U8 *) s));
+        av_push(av, newSVuv(ret_len));
+        RETVAL = av;
+    OUTPUT:
+        RETVAL
+
 UV
 test_toLOWER(UV ord)
     CODE:
index 51d5ab4..fd3c903 100644 (file)
@@ -751,12 +751,20 @@ for my $restriction (sort keys %restriction_types) {
         next if $use_flags eq "" && $restriction eq "fits_in_31_bits";
 
         # Start building up the name of the function we will test.
-        my $name = "is_";
+        my $base_name = "is_";
 
         if (! $use_flags  && $restriction ne "") {
-            $name .= $restriction . "_";
+            $base_name .= $restriction . "_";
         }
-        $name .= "utf8_string";
+
+        # We test both "is_utf8_string_foo" and "is_fixed_width_buf" functions
+        foreach my $operand ('string', 'fixed_width_buf') {
+
+            # Currently, the only fixed_width_buf functions have the '_flags'
+            # suffix.
+            next if $operand eq 'fixed_width_buf' && $use_flags eq "";
+
+            my $name = "${base_name}utf8_$operand";
 
             # We test each version of the function
             for my $function ("_loclen", "_loc", "") {
@@ -765,7 +773,9 @@ for my $restriction (sort keys %restriction_types) {
                 #   a) valid input
                 #   b) invalid input created by appending an out-of-place
                 #      continuation character to the valid string
-                #   c) invalid input created by appending a partial character
+                #   c) input created by appending a partial character.  This
+                #      is valid in the 'fixed_width' functions, but invalid in
+                #   the 'string' ones
                 #   d) invalid input created by calling a function that is
                 #      expecting a restricted form of the input using the string
                 #      that's valid when unrestricted
@@ -788,10 +798,12 @@ for my $restriction (sort keys %restriction_types) {
                     if ($this_error_type) {
 
                         # Appending a bare continuation byte or a partial
-                        # character makes it invalid, but the character count
-                        # and offset remain the same.  But in the other cases,
-                        # we have saved where the failures should occur, so
-                        # use those.
+                        # character doesn't change the character count or
+                        # offset.  But in the other cases, we have saved where
+                        # the failures should occur, so use those.  Appending
+                        # a continuation byte makes it invalid; appending a
+                        # partial character makes the 'string' form invalid,
+                        # but not the 'fixed_width_buf' form.
                         if ($this_error_type eq $cont_byte || $this_error_type eq $p) {
                             $bytes .= $this_error_type;
                             if ($this_error_type eq $cont_byte) {
@@ -801,6 +813,8 @@ for my $restriction (sort keys %restriction_types) {
                             else {
                                 $test_name_suffix
                                         = " if ends with a partial character";
+                                $this_error_type
+                                        = 0 if $operand eq "fixed_width_buf";
                             }
                         }
                         else {
@@ -935,6 +949,7 @@ for my $restriction (sort keys %restriction_types) {
                     }
                 }
             }
+        }
     }
 }
 
index 1fc9065..66ba348 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -341,6 +341,9 @@ C<L</is_utf8_string_loc>>,
 C<L</is_utf8_string_loc_flags>>,
 C<L</is_utf8_string_loclen>>,
 C<L</is_utf8_string_loclen_flags>>,
+C<L</is_utf8_fixed_width_buf_flags>>,
+C<L</is_utf8_fixed_width_buf_loc_flags>>,
+C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 C<L</is_strict_utf8_string>>,
 C<L</is_strict_utf8_string_loc>>,
 C<L</is_strict_utf8_string_loclen>>,
@@ -387,6 +390,9 @@ See also
 C<L</is_utf8_invariant_string>>,
 C<L</is_utf8_string_loc>>,
 C<L</is_utf8_string_loclen>>,
+C<L</is_utf8_fixed_width_buf_flags>>,
+C<L</is_utf8_fixed_width_buf_loc_flags>>,
+C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 
 =cut
 */
@@ -435,6 +441,9 @@ C<L</is_utf8_string_loc>>,
 C<L</is_utf8_string_loc_flags>>,
 C<L</is_utf8_string_loclen>>,
 C<L</is_utf8_string_loclen_flags>>,
+C<L</is_utf8_fixed_width_buf_flags>>,
+C<L</is_utf8_fixed_width_buf_loc_flags>>,
+C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 C<L</is_strict_utf8_string_loc>>,
 C<L</is_strict_utf8_string_loclen>>,
 C<L</is_c9strict_utf8_string>>,
@@ -488,6 +497,9 @@ C<L</is_utf8_string_loc>>,
 C<L</is_utf8_string_loc_flags>>,
 C<L</is_utf8_string_loclen>>,
 C<L</is_utf8_string_loclen_flags>>,
+C<L</is_utf8_fixed_width_buf_flags>>,
+C<L</is_utf8_fixed_width_buf_loc_flags>>,
+C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 C<L</is_strict_utf8_string>>,
 C<L</is_strict_utf8_string_loc>>,
 C<L</is_strict_utf8_string_loclen>>,
@@ -546,6 +558,9 @@ C<L</is_utf8_string_loc>>,
 C<L</is_utf8_string_loc_flags>>,
 C<L</is_utf8_string_loclen>>,
 C<L</is_utf8_string_loclen_flags>>,
+C<L</is_utf8_fixed_width_buf_flags>>,
+C<L</is_utf8_fixed_width_buf_loc_flags>>,
+C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 C<L</is_strict_utf8_string>>,
 C<L</is_strict_utf8_string_loc>>,
 C<L</is_strict_utf8_string_loclen>>,
@@ -968,6 +983,80 @@ S_is_utf8_valid_partial_char_flags(const U8 * const s, const U8 * const e, const
     return cBOOL(_is_utf8_char_helper(s, e, flags));
 }
 
+/*
+
+=for apidoc is_utf8_fixed_width_buf_flags
+
+Returns TRUE if the fixed-width buffer starting at C<s> with length C<len>
+is entirely valid UTF-8, subject to the restrictions given by C<flags>;
+otherwise it returns FALSE.
+
+If C<flags> is 0, any well-formed UTF-8, as extended by Perl, is accepted
+without restriction.  If the final few bytes of the buffer do not form a
+complete code point, this will return TRUE anyway, provided that
+C<L</is_utf8_valid_partial_char_flags>> returns TRUE for them.
+
+If C<flags> in non-zero, it can be any combination of the
+C<UTF8_DISALLOW_I<foo>> flags accepted by C<L</utf8n_to_uvchr>>, and with the
+same meanings.
+
+This function differs from C<L</is_utf8_string_flags>> only in that the latter
+returns FALSE if the final few bytes of the string don't form a complete code
+point.
+
+=cut
+ */
+#define is_utf8_fixed_width_buf_flags(s, len, flags)                        \
+                is_utf8_fixed_width_buf_loclen_flags(s, len, 0, 0, flags)
+
+/*
+
+=for apidoc is_utf8_fixed_width_buf_loc_flags
+
+Like C<L</is_utf8_fixed_width_buf_flags>> but stores the location of the
+failure in the C<ep> pointer.  If the function returns TRUE, C<*ep> will point
+to the beginning of any partial character at the end of the buffer; if there is
+no partial character C<*ep> will contain C<s>+C<len>.
+
+See also C<L</is_utf8_fixed_width_buf_loclen_flags>>.
+
+=cut
+*/
+
+#define is_utf8_fixed_width_buf_loc_flags(s, len, loc, flags)               \
+                is_utf8_fixed_width_buf_loclen_flags(s, len, loc, 0, flags)
+
+/*
+
+=for apidoc is_utf8_fixed_width_buf_loclen_flags
+
+Like C<L</is_utf8_fixed_width_buf_loc_flags>> but stores the number of
+complete, valid characters found in the C<el> pointer.
+
+=cut
+*/
+
+PERL_STATIC_INLINE bool
+S_is_utf8_fixed_width_buf_loclen_flags(const U8 * const s,
+                                       const STRLEN len,
+                                       const U8 **ep,
+                                       STRLEN *el,
+                                       const U32 flags)
+{
+    const U8 * maybe_partial;
+
+    PERL_ARGS_ASSERT_IS_UTF8_FIXED_WIDTH_BUF_LOCLEN_FLAGS;
+
+    if (! ep) {
+        ep  = &maybe_partial;
+    }
+
+    /* If it's entirely valid, return that; otherwise see if the only error is
+     * that the final few bytes are for a partial character */
+    return    is_utf8_string_loclen_flags(s, len, ep, el, flags)
+           || is_utf8_valid_partial_char_flags(*ep, s + len, flags);
+}
+
 /* ------------------------------- perl.h ----------------------------- */
 
 /*
index a198d4e..3c8e985 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3556,14 +3556,10 @@ PP(pp_fttext)
 
     assert(len);
     if (! is_utf8_invariant_string((U8 *) s, len)) {
-        const U8 *ep;
 
         /* Here contains a variant under UTF-8 .  See if the entire string is
-         * UTF-8.  But the buffer may end in a partial character, so if it
-         * failed, see if the failure was due just to that */
-        if (   is_utf8_string_loc((U8 *) s, len, &ep)
-            || is_utf8_valid_partial_char(ep, (U8 *) s + len))
-        {
+         * UTF-8. */
+        if (is_utf8_fixed_width_buf_flags((U8 *) s, len, 0)) {
             if (PL_op->op_type == OP_FTTEXT) {
                 FT_RETURNYES;
             }
diff --git a/proto.h b/proto.h
index 6e5461d..b30a593 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1555,6 +1555,11 @@ PERL_CALLCONV bool       Perl_is_utf8_digit(pTHX_ const U8 *p)
 #define PERL_ARGS_ASSERT_IS_UTF8_DIGIT \
        assert(p)
 
+/* PERL_CALLCONV bool  is_utf8_fixed_width_buf_flags(const U8 * const s, const STRLEN len, const U32 flags); */
+/* PERL_CALLCONV bool  is_utf8_fixed_width_buf_loc_flags(const U8 * const s, const STRLEN len, const U8 **ep, const U32 flags); */
+PERL_STATIC_INLINE bool        S_is_utf8_fixed_width_buf_loclen_flags(const U8 * const s, const STRLEN len, const U8 **ep, STRLEN *el, const U32 flags);
+#define PERL_ARGS_ASSERT_IS_UTF8_FIXED_WIDTH_BUF_LOCLEN_FLAGS  \
+       assert(s)
 PERL_CALLCONV bool     Perl_is_utf8_graph(pTHX_ const U8 *p)
                        __attribute__deprecated__
                        __attribute__warn_unused_result__;