pp.c: Avoid use of unsafe function

The function is unsafe because it doesn't check for running off the end
of the buffer if presented with illegal UTF-8.  The only remaining use
now is from mathoms.c.

diff --git a/embed.fnc b/embed.fnc
index d311ca7..c7816d5 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1748,7 +1748,7 @@ EXp       |SV*    |_core_swash_init|NN const char* pkg|NN const char* name \
                |NN SV* listsv|I32 minbits|I32 none \
                |NULLOK SV* invlist|NULLOK U8* const flags_p
 #endif
-#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C)
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C)
 EiMRn  |UV*    |invlist_array  |NN SV* const invlist
 EiMRn  |bool   |is_invlist     |NN SV* const invlist
 EiMRn  |bool*  |get_invlist_offset_addr|NN SV* invlist

diff --git a/embed.h b/embed.h
index f3b95ea..149f1be 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1249,7 +1249,7 @@
 #endif
 #define regprop(a,b,c,d,e)     Perl_regprop(aTHX_ a,b,c,d,e)
 #  endif
-#  if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C)
+#  if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C)
 #define _get_swash_invlist(a)  Perl__get_swash_invlist(aTHX_ a)
 #define _invlist_contains_cp   S__invlist_contains_cp
 #define _invlist_len           S__invlist_len

diff --git a/invlist_inline.h b/invlist_inline.h
index cd002ce..1304b45 100644 (file)
--- a/invlist_inline.h
+++ b/invlist_inline.h
@@ -9,7 +9,7 @@
 #ifndef PERL_INVLIST_INLINE_H_
 #define PERL_INVLIST_INLINE_H_
 
-#if defined(PERL_IN_UTF8_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C)
+#if defined(PERL_IN_UTF8_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_PP_C)
 
 /* An element is in an inversion list iff its index is even numbered: 0, 2, 4,
  * etc */

diff --git a/pp.c b/pp.c
index 9e4c3b2..790f82b 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -28,6 +28,7 @@
 #include "perl.h"
 #include "keywords.h"
 
+#include "invlist_inline.h"
 #include "reentr.h"
 #include "regcharclass.h"
 
@@ -4039,12 +4040,16 @@ PP(pp_uc)
            STRLEN u;
            STRLEN ulen;
            UV uv;
-           if (UNLIKELY(in_iota_subscript) && ! _is_utf8_mark(s)) {
+           if (UNLIKELY(in_iota_subscript)) {
+                UV cp = utf8_to_uvchr_buf(s, send, NULL);
+
+                if (! _invlist_contains_cp(PL_utf8_mark, cp)) {
 
                /* A non-mark.  Time to output the iota subscript */
                *d++ = UTF8_TWO_BYTE_HI(GREEK_CAPITAL_LETTER_IOTA);
                *d++ = UTF8_TWO_BYTE_LO(GREEK_CAPITAL_LETTER_IOTA);
                in_iota_subscript = FALSE;
+                }
             }
 
             /* Then handle the current character.  Get the changed case value

diff --git a/proto.h b/proto.h
index daf3387..ba5623d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5650,7 +5650,7 @@ PERL_CALLCONV void        Perl_regprop(pTHX_ const regexp *prog, SV* sv, const regnode*
 #define PERL_ARGS_ASSERT_REGPROP       \
        assert(sv); assert(o)
 #endif
-#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C)
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C)
 PERL_CALLCONV SV*      Perl__get_swash_invlist(pTHX_ SV* const swash)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT__GET_SWASH_INVLIST    \