diff options
author | Karl Williamson <khw@cpan.org> | 2021-06-28 12:59:52 -0600 |
---|---|---|
committer | Karl Williamson <khw@cpan.org> | 2021-08-07 05:14:44 -0600 |
commit | b3501144d975745427dbee79cd3eddd22d140c7c (patch) | |
tree | 1b52fb14f18a1badd3bd45a072c54c4a92b0956b | |
parent | bc658500639af2d2587b6616c7a854049ea21972 (diff) | |
download | perl-b3501144d975745427dbee79cd3eddd22d140c7c.tar.gz |
uvoffuni_to_utf8_flags_msgs: Avoid extra conditionals
The previous commit for EBCDIC paved the way for moving some checks for
a code point being for Perl extended UTF-8 out of places where they
cannot succeed. The resultant simplifications more than compensate for
the two extra case statements added by this commit.
-rw-r--r-- | embed.fnc | 2 | ||||
-rw-r--r-- | proto.h | 2 | ||||
-rw-r--r-- | utf8.c | 69 |
3 files changed, 46 insertions, 27 deletions
@@ -2593,7 +2593,7 @@ Adm |U8* |uvchr_to_utf8 |NN U8 *d|UV uv Cp |U8* |uvuni_to_utf8 |NN U8 *d|UV uv Adm |U8* |uvchr_to_utf8_flags |NN U8 *d|UV uv|UV flags Adm |U8* |uvchr_to_utf8_flags_msgs|NN U8 *d|UV uv|UV flags|NULLOK HV ** msgs -CMpd |U8* |uvoffuni_to_utf8_flags |NN U8 *d|UV uv|const UV flags +CMpd |U8* |uvoffuni_to_utf8_flags |NN U8 *d|UV uv|UV flags Cp |U8* |uvoffuni_to_utf8_flags_msgs|NN U8 *d|UV input_uv|const UV flags|NULLOK HV** msgs CdpbD |U8* |uvuni_to_utf8_flags |NN U8 *d|UV uv|UV flags Apd |char* |pv_uni_display |NN SV *dsv|NN const U8 *spv|STRLEN len|STRLEN pvlim|UV flags @@ -4092,7 +4092,7 @@ PERL_CALLCONV void Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* idop #define PERL_ARGS_ASSERT_UVCHR_TO_UTF8_FLAGS /* PERL_CALLCONV U8* uvchr_to_utf8_flags_msgs(pTHX_ U8 *d, UV uv, UV flags, HV ** msgs); */ #define PERL_ARGS_ASSERT_UVCHR_TO_UTF8_FLAGS_MSGS -PERL_CALLCONV U8* Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, const UV flags); +PERL_CALLCONV U8* Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags); #define PERL_ARGS_ASSERT_UVOFFUNI_TO_UTF8_FLAGS \ assert(d) PERL_CALLCONV U8* Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV input_uv, const UV flags, HV** msgs); @@ -260,7 +260,7 @@ The caller, of course, is responsible for freeing any returned HV. /* Undocumented; we don't want people using this. Instead they should use * uvchr_to_utf8_flags_msgs() */ U8 * -Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV input_uv, const UV flags, HV** msgs) +Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV input_uv, UV flags, HV** msgs) { U8 *p; UV shifted_uv = input_uv; @@ -284,44 +284,63 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV input_uv, const UV flags, HV** Perl_croak(aTHX_ "%s", form_cp_too_large_msg(16, NULL, 0, input_uv)); } + if ((flags & (UNICODE_WARN_PERL_EXTENDED|UNICODE_WARN_SUPER))) { + U32 category = packWARN2(WARN_NON_UNICODE, WARN_PORTABLE); + const char * format = PL_extended_cp_format; + if (msgs) { + *msgs = new_msg_hv(Perl_form(aTHX_ format, input_uv), + category, + UNICODE_GOT_PERL_EXTENDED); + } + else { + Perl_ck_warner_d(aTHX_ category, format, input_uv); + } + + /* Don't output a 2nd msg */ + flags &= ~UNICODE_WARN_SUPER; + } + + if (flags & UNICODE_DISALLOW_PERL_EXTENDED) { + return NULL; + } + p = d + utf8_skip - 1; - while (p >= d + 4 + ONE_IF_EBCDIC_ZERO_IF_NOT) { + while (p >= d + 6 + ONE_IF_EBCDIC_ZERO_IF_NOT) { *p-- = I8_TO_NATIVE_UTF8((shifted_uv & MASK) | MARK); shifted_uv >>= SHIFT; } /* FALLTHROUGH */ + case 6 + ONE_IF_EBCDIC_ZERO_IF_NOT: + d[5 + ONE_IF_EBCDIC_ZERO_IF_NOT] + = I8_TO_NATIVE_UTF8((shifted_uv & MASK) | MARK); + shifted_uv >>= SHIFT; + /* FALLTHROUGH */ + + case 5 + ONE_IF_EBCDIC_ZERO_IF_NOT: + d[4 + ONE_IF_EBCDIC_ZERO_IF_NOT] + = I8_TO_NATIVE_UTF8((shifted_uv & MASK) | MARK); + shifted_uv >>= SHIFT; + /* FALLTHROUGH */ + case 4 + ONE_IF_EBCDIC_ZERO_IF_NOT: if (UNLIKELY(UNICODE_IS_SUPER(input_uv))) { - if ( (flags & UNICODE_WARN_SUPER) - || ( (flags & UNICODE_WARN_PERL_EXTENDED) - && UNICODE_IS_PERL_EXTENDED(input_uv))) - { - const char * format = super_cp_format; + if (flags & UNICODE_WARN_SUPER) { U32 category = packWARN(WARN_NON_UNICODE); - U32 flag = UNICODE_GOT_SUPER; - - /* Choose the more dire applicable warning */ - if (UNICODE_IS_PERL_EXTENDED(input_uv)) { - format = PL_extended_cp_format; - category = packWARN2(WARN_NON_UNICODE, WARN_PORTABLE); - if (flags & (UNICODE_WARN_PERL_EXTENDED - |UNICODE_DISALLOW_PERL_EXTENDED)) - { - flag = UNICODE_GOT_PERL_EXTENDED; - } - } + const char * format = super_cp_format; if (msgs) { *msgs = new_msg_hv(Perl_form(aTHX_ format, input_uv), - category, flag); + category, + UNICODE_GOT_SUPER); } - else if ( ckWARN_d(WARN_NON_UNICODE) - || ( (flag & UNICODE_GOT_PERL_EXTENDED) - && ckWARN(WARN_PORTABLE))) - { - Perl_warner(aTHX_ category, format, input_uv); + else { + Perl_ck_warner_d(aTHX_ category, format, input_uv); + } + + if (flags & UNICODE_DISALLOW_SUPER) { + return NULL; } } if ( (flags & UNICODE_DISALLOW_SUPER) |