Add is_utf8_non_invariant_string()

This function tells whether or not its argument is a sequence of bytes
that is legal Perl-extended-UTF-8, and which either requires UTF-8
(because it contains wide characters) or would have a different
representation when not under UTF-8.

This paradigm is used in several places in the perl core to decide
whether to turn on an SV's utf8 flag.  None of those places realized
that there was a simple way to avoid rescanning the string (though
perhaps a good C optimizer would).  This commit creates a funtion that
does this task without the rescan; the next commits will convert to use
this function.

diff --git a/embed.fnc b/embed.fnc
index 6f566da..eeaf050 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -784,6 +784,10 @@ AnidR      |bool   |is_utf8_invariant_string_loc|NN const U8* const s          \
                |NULLOK const U8 ** ep
 AmnpdRP        |bool   |is_ascii_string|NN const U8* const s|const STRLEN len
 AmnpdRP        |bool   |is_invariant_string|NN const U8* const s|const STRLEN len
+#if defined(PERL_CORE) || defined (PERL_EXT)
+EXnidR |bool   |is_utf8_non_invariant_string|NN const U8* const s          \
+               |STRLEN len
+#endif
 AnpdD  |STRLEN |is_utf8_char   |NN const U8 *s
 Abmnpd |STRLEN |is_utf8_char_buf|NN const U8 *buf|NN const U8 *buf_end
 AnmdpR |bool   |is_utf8_string |NN const U8 *s|STRLEN len

diff --git a/embed.h b/embed.h
index 5d67b97..21c8328 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -991,6 +991,7 @@
 #define sv_setsv_cow(a,b)      Perl_sv_setsv_cow(aTHX_ a,b)
 #  endif
 #  if defined(PERL_CORE) || defined (PERL_EXT)
+#define is_utf8_non_invariant_string   S_is_utf8_non_invariant_string
 #define sv_or_pv_pos_u2b(a,b,c,d)      S_sv_or_pv_pos_u2b(aTHX_ a,b,c,d)
 #  endif
 #  if defined(PERL_IN_REGCOMP_C)

diff --git a/inline.h b/inline.h
index aa8798e..309d74f 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -486,6 +486,51 @@ C<L</is_utf8_fixed_width_buf_loclen_flags>>,
 
 #define is_utf8_string(s, len)  is_utf8_string_loclen(s, len, NULL, NULL)
 
+#if defined(PERL_CORE) || defined (PERL_EXT)
+
+/*
+=for apidoc is_utf8_non_invariant_string
+
+Returns TRUE if L<perlapi/is_utf8_invariant_string> returns FALSE for the first
+C<len> bytes of the string C<s>, but they are, nonetheless, legal Perl-extended
+UTF-8; otherwise returns FALSE.
+
+A TRUE return means that at least one code point represented by the sequence
+either is a wide character not representable as a single byte, or the
+representation differs depending on whether the sequence is encoded in UTF-8 or
+not.
+
+See also
+C<L<perlapi/is_utf8_invariant_string>>,
+C<L<perlapi/is_utf8_string>>
+
+=cut
+
+This is commonly used to determine if a SV's UTF-8 flag should be turned on.
+It needn't be if its string is entirely UTF-8 invariant, and it shouldn't be if
+it otherwise contains invalid UTF-8.
+
+It is an internal function because khw thinks that XS code shouldn't be working
+at this low a level.  A valid use case could change that.
+
+*/
+
+PERL_STATIC_INLINE bool
+S_is_utf8_non_invariant_string(const U8* const s, STRLEN len)
+{
+    const U8 * first_variant;
+
+    PERL_ARGS_ASSERT_IS_UTF8_NON_INVARIANT_STRING;
+
+    if (is_utf8_invariant_string_loc(s, len, &first_variant)) {
+        return FALSE;
+    }
+
+    return is_utf8_string(first_variant, len - (first_variant - s));
+}
+
+#endif
+
 /*
 =for apidoc is_strict_utf8_string
 

diff --git a/proto.h b/proto.h
index c7fcd86..39276fa 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4303,6 +4303,13 @@ PERL_CALLCONV void       Perl_Slab_to_rw(pTHX_ OPSLAB *const slab);
 #endif
 #if defined(PERL_CORE) || defined (PERL_EXT)
 #ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE bool        S_is_utf8_non_invariant_string(const U8* const s, STRLEN len)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_IS_UTF8_NON_INVARIANT_STRING  \
+       assert(s)
+#endif
+
+#ifndef PERL_NO_INLINE_FUNCTIONS
 PERL_STATIC_INLINE STRLEN      S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp);
 #define PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B      \
        assert(sv); assert(pv)