five bytes or more.
=cut */
-STATIC STRLEN
+PERL_STATIC_INLINE STRLEN
S_is_utf8_char_slow(const U8 *s, const STRLEN len)
{
dTHX; /* The function called below requires thread context */
if (UTF8_IS_INVARIANT(*x)) {
x++;
}
- else if (!UTF8_IS_START(*x))
- return FALSE;
else {
/* ... and call is_utf8_char() only if really needed. */
const STRLEN c = UTF8SKIP(x);
/* Inline the easy bits of is_utf8_char() here for speed... */
if (UTF8_IS_INVARIANT(*x))
next_char_ptr = x + 1;
- else if (!UTF8_IS_START(*x))
- goto out;
else {
/* ... and call is_utf8_char() only if really needed. */
c = UTF8SKIP(x);
The UTF8_CHECK_ONLY flag overrides the behavior when a non-allowed (by other
flags) malformation is found. If this flag is set, the routine assumes that
the caller will raise a warning, and this function will silently just set
-C<retlen> to C<-1> and return zero.
+C<retlen> to C<-1> (cast to C<STRLEN>) and return zero.
+
+Note that this API requires disambiguation between successful decoding a NUL
+character, and an error return (unless the UTF8_CHECK_ONLY flag is set), as
+in both cases, 0 is returned. To disambiguate, upon a zero return, see if the
+first byte of C<s> is 0 as well. If so, the input was a NUL; if not, the input
+had an error.
Certain code points are considered problematic. These are Unicode surrogates,
Unicode non-characters, and code points above the Unicode maximum of 0x10FFFF.
if (e < s)
goto warn_and_return;
while (s < e) {
- if (!UTF8_IS_INVARIANT(*s))
- s += UTF8SKIP(s);
- else
- s++;
+ s += UTF8SKIP(s);
len++;
}
}
bool
+Perl_is_uni_alnumc(pTHX_ UV c)
+{
+ U8 tmpbuf[UTF8_MAXBYTES+1];
+ uvchr_to_utf8(tmpbuf, c);
+ return is_utf8_alnumc(tmpbuf);
+}
+
+bool /* Internal function so we can deprecate the external one, and call
+ this one from other deprecated functions in this file */
+S_is_utf8_idfirst(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ if (*p == '_')
+ return TRUE;
+ /* is_utf8_idstart would be more logical. */
+ return is_utf8_common(p, &PL_utf8_idstart, "IdStart");
+}
+
+bool
Perl_is_uni_idfirst(pTHX_ UV c)
{
U8 tmpbuf[UTF8_MAXBYTES+1];
uvchr_to_utf8(tmpbuf, c);
- return is_utf8_idfirst(tmpbuf);
+ return S_is_utf8_idfirst(aTHX_ tmpbuf);
+}
+
+bool
+Perl__is_uni_perl_idstart(pTHX_ UV c)
+{
+ U8 tmpbuf[UTF8_MAXBYTES+1];
+ uvchr_to_utf8(tmpbuf, c);
+ return _is_utf8_perl_idstart(tmpbuf);
}
bool
bool
Perl_is_uni_blank(pTHX_ UV c)
{
- U8 tmpbuf[UTF8_MAXBYTES+1];
- uvchr_to_utf8(tmpbuf, c);
- return is_utf8_blank(tmpbuf);
+ return isBLANK_uni(c);
}
bool
Perl_is_uni_space(pTHX_ UV c)
{
- U8 tmpbuf[UTF8_MAXBYTES+1];
- uvchr_to_utf8(tmpbuf, c);
- return is_utf8_space(tmpbuf);
+ return isSPACE_uni(c);
}
bool
bool
Perl_is_uni_xdigit(pTHX_ UV c)
{
- U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
- uvchr_to_utf8(tmpbuf, c);
- return is_utf8_xdigit(tmpbuf);
+ return isXDIGIT_uni(c);
}
UV
}
}
-/* for now these all assume no locale info available for Unicode > 255; and
- * the corresponding macros in handy.h (like isALNUM_LC_uvchr) should have been
- * called instead, so that these don't get called for < 255 */
-
bool
Perl_is_uni_alnum_lc(pTHX_ UV c)
{
- return is_uni_alnum(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isALNUM_LC(UNI_TO_NATIVE(c));
+ }
+ return is_uni_alnum(c);
+}
+
+bool
+Perl_is_uni_alnumc_lc(pTHX_ UV c)
+{
+ if (c < 256) {
+ return isALNUMC_LC(UNI_TO_NATIVE(c));
+ }
+ return is_uni_alnumc(c);
}
bool
Perl_is_uni_idfirst_lc(pTHX_ UV c)
{
- return is_uni_idfirst(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isIDFIRST_LC(UNI_TO_NATIVE(c));
+ }
+ return _is_uni_perl_idstart(c);
}
bool
Perl_is_uni_alpha_lc(pTHX_ UV c)
{
- return is_uni_alpha(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isALPHA_LC(UNI_TO_NATIVE(c));
+ }
+ return is_uni_alpha(c);
}
bool
Perl_is_uni_ascii_lc(pTHX_ UV c)
{
- return is_uni_ascii(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isASCII_LC(UNI_TO_NATIVE(c));
+ }
+ return 0;
}
bool
Perl_is_uni_blank_lc(pTHX_ UV c)
{
- return is_uni_blank(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isBLANK_LC(UNI_TO_NATIVE(c));
+ }
+ return isBLANK_uni(c);
}
bool
Perl_is_uni_space_lc(pTHX_ UV c)
{
- return is_uni_space(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isSPACE_LC(UNI_TO_NATIVE(c));
+ }
+ return isSPACE_uni(c);
}
bool
Perl_is_uni_digit_lc(pTHX_ UV c)
{
- return is_uni_digit(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isDIGIT_LC(UNI_TO_NATIVE(c));
+ }
+ return is_uni_digit(c);
}
bool
Perl_is_uni_upper_lc(pTHX_ UV c)
{
- return is_uni_upper(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isUPPER_LC(UNI_TO_NATIVE(c));
+ }
+ return is_uni_upper(c);
}
bool
Perl_is_uni_lower_lc(pTHX_ UV c)
{
- return is_uni_lower(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isLOWER_LC(UNI_TO_NATIVE(c));
+ }
+ return is_uni_lower(c);
}
bool
Perl_is_uni_cntrl_lc(pTHX_ UV c)
{
- return is_uni_cntrl(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isCNTRL_LC(UNI_TO_NATIVE(c));
+ }
+ return 0;
}
bool
Perl_is_uni_graph_lc(pTHX_ UV c)
{
- return is_uni_graph(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isGRAPH_LC(UNI_TO_NATIVE(c));
+ }
+ return is_uni_graph(c);
}
bool
Perl_is_uni_print_lc(pTHX_ UV c)
{
- return is_uni_print(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isPRINT_LC(UNI_TO_NATIVE(c));
+ }
+ return is_uni_print(c);
}
bool
Perl_is_uni_punct_lc(pTHX_ UV c)
{
- return is_uni_punct(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isPUNCT_LC(UNI_TO_NATIVE(c));
+ }
+ return is_uni_punct(c);
}
bool
Perl_is_uni_xdigit_lc(pTHX_ UV c)
{
- return is_uni_xdigit(c); /* XXX no locale support yet */
+ if (c < 256) {
+ return isXDIGIT_LC(UNI_TO_NATIVE(c));
+ }
+ return isXDIGIT_uni(c);
}
U32
return (U32)to_uni_lower(c, tmpbuf, &len);
}
-static bool
+PERL_STATIC_INLINE bool
S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
const char *const swashname)
{
}
bool
+Perl_is_utf8_alnumc(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_ALNUMC;
+
+ return is_utf8_common(p, &PL_utf8_alnumc, "IsAlnum");
+}
+
+bool
Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */
{
dVAR;
PERL_ARGS_ASSERT_IS_UTF8_IDFIRST;
- if (*p == '_')
- return TRUE;
- /* is_utf8_idstart would be more logical. */
- return is_utf8_common(p, &PL_utf8_idstart, "IdStart");
+ return S_is_utf8_idfirst(aTHX_ p);
}
bool
}
bool
-Perl__is_utf8__perl_idstart(pTHX_ const U8 *p)
+Perl__is_utf8_perl_idstart(pTHX_ const U8 *p)
{
dVAR;
- PERL_ARGS_ASSERT__IS_UTF8__PERL_IDSTART;
+ PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART;
return is_utf8_common(p, &PL_utf8_perl_idstart, "_Perl_IDStart");
}
PERL_ARGS_ASSERT_IS_UTF8_BLANK;
- return is_utf8_common(p, &PL_utf8_blank, "XPosixBlank");
+ return isBLANK_utf8(p);
}
bool
PERL_ARGS_ASSERT_IS_UTF8_SPACE;
- return is_utf8_common(p, &PL_utf8_space, "IsXPerlSpace");
+ return isSPACE_utf8(p);
}
bool
PERL_ARGS_ASSERT_IS_UTF8_CNTRL;
- if (isASCII(*p)) {
- return isCNTRL_A(*p);
- }
-
- /* All controls are in Latin1 */
- if (! UTF8_IS_DOWNGRADEABLE_START(*p)) {
- return 0;
- }
- return isCNTRL_L1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+ return isCNTRL_utf8(p);
}
bool
PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
- return is_utf8_common(p, &PL_utf8_xdigit, "IsXDigit");
+ return is_XDIGIT_utf8(p);
}
bool
}
bool
-Perl_is_utf8_X_begin(pTHX_ const U8 *p)
+Perl_is_utf8_X_regular_begin(pTHX_ const U8 *p)
{
dVAR;
- PERL_ARGS_ASSERT_IS_UTF8_X_BEGIN;
+ PERL_ARGS_ASSERT_IS_UTF8_X_REGULAR_BEGIN;
- return is_utf8_common(p, &PL_utf8_X_begin, "_X_Begin");
+ return is_utf8_common(p, &PL_utf8_X_regular_begin, "_X_Regular_Begin");
}
bool
return is_utf8_common(p, &PL_utf8_X_extend, "_X_Extend");
}
-bool
-Perl_is_utf8_X_prepend(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_PREPEND;
-
- return is_utf8_common(p, &PL_utf8_X_prepend, "_X_GCB_Prepend");
-}
-
-bool
-Perl_is_utf8_X_non_hangul(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_NON_HANGUL;
-
- return is_utf8_common(p, &PL_utf8_X_non_hangul, "_X_HST_Not_Applicable");
-}
-
-bool
-Perl_is_utf8_X_L(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_L;
-
- return is_utf8_common(p, &PL_utf8_X_L, "_X_GCB_L");
-}
-
-/* These constants are for finding GCB=LV and GCB=LVT. These are for the
- * pre-composed Hangul syllables, which are all in a contiguous block and
- * arranged there in such a way so as to facilitate alorithmic determination of
- * their characteristics. As such, they don't need a swash, but can be
- * determined by simple arithmetic. Almost all are GCB=LVT, but every 28th one
- * is a GCB=LV */
-#define SBASE 0xAC00 /* Start of block */
-#define SCount 11172 /* Length of block */
-#define TCount 28
-
-#if 0 /* This routine is not currently used */
-bool
-Perl_is_utf8_X_LV(pTHX_ const U8 *p)
-{
- /* Unlike most other similarly named routines here, this does not create a
- * swash, so swash_fetch() cannot be used on PL_utf8_X_LV. */
-
- dVAR;
-
- UV cp = valid_utf8_to_uvchr(p, NULL);
-
- PERL_ARGS_ASSERT_IS_UTF8_X_LV;
-
- /* The earliest Unicode releases did not have these precomposed Hangul
- * syllables. Set to point to undef in that case, so will return false on
- * every call */
- if (! PL_utf8_X_LV) { /* Set up if this is the first time called */
- PL_utf8_X_LV = swash_init("utf8", "_X_GCB_LV", &PL_sv_undef, 1, 0);
- if (_invlist_len(_get_swash_invlist(PL_utf8_X_LV)) == 0) {
- SvREFCNT_dec(PL_utf8_X_LV);
- PL_utf8_X_LV = &PL_sv_undef;
- }
- }
-
- return (PL_utf8_X_LV != &PL_sv_undef
- && cp >= SBASE && cp < SBASE + SCount
- && (cp - SBASE) % TCount == 0); /* Only every TCount one is LV */
-}
-#endif
-
-bool
-Perl_is_utf8_X_LVT(pTHX_ const U8 *p)
-{
- /* Unlike most other similarly named routines here, this does not create a
- * swash, so swash_fetch() cannot be used on PL_utf8_X_LVT. */
-
- dVAR;
-
- UV cp = valid_utf8_to_uvchr(p, NULL);
-
- PERL_ARGS_ASSERT_IS_UTF8_X_LVT;
-
- /* The earliest Unicode releases did not have these precomposed Hangul
- * syllables. Set to point to undef in that case, so will return false on
- * every call */
- if (! PL_utf8_X_LVT) { /* Set up if this is the first time called */
- PL_utf8_X_LVT = swash_init("utf8", "_X_GCB_LVT", &PL_sv_undef, 1, 0);
- if (_invlist_len(_get_swash_invlist(PL_utf8_X_LVT)) == 0) {
- SvREFCNT_dec(PL_utf8_X_LVT);
- PL_utf8_X_LVT = &PL_sv_undef;
- }
- }
-
- return (PL_utf8_X_LVT != &PL_sv_undef
- && cp >= SBASE && cp < SBASE + SCount
- && (cp - SBASE) % TCount != 0); /* All but every TCount one is LV */
-}
-
-bool
-Perl_is_utf8_X_T(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_T;
-
- return is_utf8_common(p, &PL_utf8_X_T, "_X_GCB_T");
-}
-
-bool
-Perl_is_utf8_X_V(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_V;
-
- return is_utf8_common(p, &PL_utf8_X_V, "_X_GCB_V");
-}
-
-bool
-Perl_is_utf8_X_LV_LVT_V(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_LV_LVT_V;
-
- return is_utf8_common(p, &PL_utf8_X_LV_LVT_V, "_X_LV_LVT_V");
-}
-
-bool
-Perl__is_utf8_quotemeta(pTHX_ const U8 *p)
-{
- /* For exclusive use of pp_quotemeta() */
-
- dVAR;
-
- PERL_ARGS_ASSERT__IS_UTF8_QUOTEMETA;
-
- return is_utf8_common(p, &PL_utf8_quotemeta, "_Perl_Quotemeta");
-}
-
/*
=for apidoc to_utf8_case
/* Here, there was no mapping defined, which means that the code point maps
* to itself. Return the inputs */
len = UTF8SKIP(p);
- Copy(p, ustrp, len, U8);
+ if (p != ustrp) { /* Don't copy onto itself */
+ Copy(p, ustrp, len, U8);
+ }
if (lenp)
*lenp = len;
* by calling utf8_heavy.pl in the general case. The returned value may be
* the swash's inversion list instead if the input parameters allow it.
* Which is returned should be immaterial to callers, as the only
- * operations permitted on a swash, swash_fetch() and
- * _get_swash_invlist(), handle both these transparently.
+ * operations permitted on a swash, swash_fetch(), _get_swash_invlist(),
+ * and swash_to_invlist() handle both these transparently.
*
* This interface should only be used by functions that won't destroy or
* adversely change the swash, as doing so affects all other uses of the
ENTER;
SAVEHINTS();
save_re_context();
+ /* We might get here via a subroutine signature which uses a utf8
+ * parameter name, at which point PL_subname will have been set
+ * but not yet used. */
+ save_item(PL_subname);
if (PL_parser && PL_parser->error_count)
SAVEI8(PL_parser->error_count), PL_parser->error_count = 0;
method = gv_fetchmeth(stash, "SWASHNEW", 8, -1);
if (!method) { /* demand load utf8 */
ENTER;
- errsv_save = newSVsv(ERRSV);
+ if ((errsv_save = GvSV(PL_errgv))) SAVEFREESV(errsv_save);
+ GvSV(PL_errgv) = NULL;
/* It is assumed that callers of this routine are not passing in
* any user derived data. */
/* Need to do this after save_re_context() as it will set
* PL_tainted to 1 while saving $1 etc (see the code after getrx:
* in Perl_magic_get). Even line to create errsv_save can turn on
* PL_tainted. */
- SAVEBOOL(PL_tainted);
- PL_tainted = 0;
+#ifndef NO_TAINT_SUPPORT
+ SAVEBOOL(TAINT_get);
+ TAINT_NOT;
+#endif
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn(pkg,pkg_len),
NULL);
- if (!SvTRUE(ERRSV))
- sv_setsv(ERRSV, errsv_save);
- SvREFCNT_dec(errsv_save);
+ {
+ /* Not ERRSV, as there is no need to vivify a scalar we are
+ about to discard. */
+ SV * const errsv = GvSV(PL_errgv);
+ if (!SvTRUE(errsv)) {
+ GvSV(PL_errgv) = SvREFCNT_inc_simple(errsv_save);
+ SvREFCNT_dec(errsv);
+ }
+ }
LEAVE;
}
SPAGAIN;
mPUSHi(minbits);
mPUSHi(none);
PUTBACK;
- errsv_save = newSVsv(ERRSV);
+ if ((errsv_save = GvSV(PL_errgv))) SAVEFREESV(errsv_save);
+ GvSV(PL_errgv) = NULL;
/* If we already have a pointer to the method, no need to use
* call_method() to repeat the lookup. */
- if (method ? call_sv(MUTABLE_SV(method), G_SCALAR)
+ if (method
+ ? call_sv(MUTABLE_SV(method), G_SCALAR)
: call_sv(newSVpvs_flags("SWASHNEW", SVs_TEMP), G_SCALAR | G_METHOD))
{
retval = *PL_stack_sp--;
SvREFCNT_inc(retval);
}
- if (!SvTRUE(ERRSV))
- sv_setsv(ERRSV, errsv_save);
- SvREFCNT_dec(errsv_save);
+ {
+ /* Not ERRSV. See above. */
+ SV * const errsv = GvSV(PL_errgv);
+ if (!SvTRUE(errsv)) {
+ GvSV(PL_errgv) = SvREFCNT_inc_simple(errsv_save);
+ SvREFCNT_dec(errsv);
+ }
+ }
LEAVE;
POPSTACK;
if (IN_PERL_COMPILETIME) {
SV** swash_invlistsvp = NULL;
SV* swash_invlist = NULL;
bool invlist_in_swash_is_valid = FALSE;
+ bool swash_invlist_unclaimed = FALSE; /* whether swash_invlist has
+ an unclaimed reference count */
/* If this operation fetched a swash, get its already existing
* inversion list, or create one for it */
}
else {
swash_invlist = _swash_to_invlist(retval);
+ swash_invlist_unclaimed = TRUE;
}
}
/* Here, there is no swash already. Set up a minimal one, if
* we are going to return a swash */
if ((int) _invlist_len(invlist) > invlist_swash_boundary) {
- swash_hv = newHV();
- retval = newRV_inc(MUTABLE_SV(swash_hv));
+ swash_hv = newHV();
+ retval = newRV_noinc(MUTABLE_SV(swash_hv));
}
swash_invlist = invlist;
}
{
Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
}
+ /* We just stole a reference count. */
+ if (swash_invlist_unclaimed) swash_invlist_unclaimed = FALSE;
+ else SvREFCNT_inc_simple_void_NN(swash_invlist);
}
+ /* Use the inversion list stand-alone if small enough */
if ((int) _invlist_len(swash_invlist) <= invlist_swash_boundary) {
SvREFCNT_dec(retval);
- retval = newRV_inc(swash_invlist);
+ if (!swash_invlist_unclaimed)
+ SvREFCNT_inc_simple_void_NN(swash_invlist);
+ retval = newRV_noinc(swash_invlist);
}
}
Perl__swash_inversion_hash(pTHX_ SV* const swash)
{
- /* Subject to change or removal. For use only in one place in regcomp.c.
+ /* Subject to change or removal. For use only in regcomp.c and regexec.c
* Can't be used on a property that is subject to user override, as it
* relies on the value of SPECIALS in the swash which would be set by
* utf8_heavy.pl to the hash in the non-overriden file, and hence is not set
STRLEN lcur;
HV *const hv = MUTABLE_HV(SvRV(swash));
- /* The string containing the main body of the table */
+ /* The string containing the main body of the table. This will have its
+ * assertion fail if the swash has been converted to its inversion list */
SV** const listsvp = hv_fetchs(hv, "LIST", FALSE);
SV** const typesvp = hv_fetchs(hv, "TYPE", FALSE);
HV *const hv = MUTABLE_HV(SvRV(swash));
UV elements = 0; /* Number of elements in the inversion list */
U8 empty[] = "";
+ SV** listsvp;
+ SV** typesvp;
+ SV** bitssvp;
+ SV** extssvp;
+ SV** invert_it_svp;
- /* The string containing the main body of the table */
- SV** const listsvp = hv_fetchs(hv, "LIST", FALSE);
- SV** const typesvp = hv_fetchs(hv, "TYPE", FALSE);
- SV** const bitssvp = hv_fetchs(hv, "BITS", FALSE);
- SV** const extssvp = hv_fetchs(hv, "EXTRAS", FALSE);
- SV** const invert_it_svp = hv_fetchs(hv, "INVERT_IT", FALSE);
-
- const U8* const typestr = (U8*)SvPV_nolen(*typesvp);
- const STRLEN bits = SvUV(*bitssvp);
- const STRLEN octets = bits >> 3; /* if bits == 1, then octets == 0 */
+ U8* typestr;
+ STRLEN bits;
+ STRLEN octets; /* if bits == 1, then octets == 0 */
U8 *x, *xend;
STRLEN xcur;
PERL_ARGS_ASSERT__SWASH_TO_INVLIST;
+ /* If not a hash, it must be the swash's inversion list instead */
+ if (SvTYPE(hv) != SVt_PVHV) {
+ return (SV*) hv;
+ }
+
+ /* The string containing the main body of the table */
+ listsvp = hv_fetchs(hv, "LIST", FALSE);
+ typesvp = hv_fetchs(hv, "TYPE", FALSE);
+ bitssvp = hv_fetchs(hv, "BITS", FALSE);
+ extssvp = hv_fetchs(hv, "EXTRAS", FALSE);
+ invert_it_svp = hv_fetchs(hv, "INVERT_IT", FALSE);
+
+ typestr = (U8*)SvPV_nolen(*typesvp);
+ bits = SvUV(*bitssvp);
+ octets = bits >> 3; /* if bits == 1, then octets == 0 */
+
/* read $swash->{LIST} */
if (SvPOK(*listsvp)) {
l = (U8*)SvPV(*listsvp, lcur);
_invlist_union(invlist, other, &invlist);
break;
case '!':
- _invlist_invert(other);
- _invlist_union(invlist, other, &invlist);
+ _invlist_union_maybe_complement_2nd(invlist, other, TRUE, &invlist);
break;
case '-':
_invlist_subtract(invlist, other, &invlist);
}
bool
-Perl_check_utf8_print(pTHX_ register const U8* s, const STRLEN len)
+Perl_check_utf8_print(pTHX_ const U8* s, const STRLEN len)
{
/* May change: warns if surrogates, non-character code points, or
* non-Unicode code points are in s which has length len bytes. Returns
C<s2>.
If C<pe1> is non-NULL and the pointer it points to is not NULL, that pointer is
-considered an end pointer beyond which scanning of C<s1> will not continue under
-any circumstances. This means that if both C<l1> and C<pe1> are specified, and
-C<pe1>
+considered an end pointer to the position 1 byte past the maximum point
+in C<s1> beyond which scanning will not continue under any circumstances.
+(This routine assumes that UTF-8 encoded input strings are not malformed;
+malformed input can cause it to read past C<pe1>).
+This means that if both C<l1> and C<pe1> are specified, and C<pe1>
is less than C<s1>+C<l1>, the match will never be successful because it can
never
get as far as its goal (and in fact is asserted against). Correspondingly for
* FOLDEQ_S2_ALREADY_FOLDED Similarly.
*/
I32
-Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, register UV l1, bool u1, const char *s2, char **pe2, register UV l2, bool u2, U32 flags)
+Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const char *s2, char **pe2, UV l2, bool u2, U32 flags)
{
dVAR;
const U8 *p1 = (const U8*)s1; /* Point to current char */
f1 = (U8 *) p1;
n1 = UTF8SKIP(f1);
}
-
else {
/* If in locale matching, we use two sets of rules, depending
* on if the code point is above or below 255. Here, we test
https://perl5.git.perl.org / perl5.git / blobdiff