**** Alterations to Henry's code are...
****
**** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- **** 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
#define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim))
#define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
- if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END
+ if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((U8*)str); assert(ok); LEAVE; } } STMT_END
#define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
#define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
#define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
register char *other_last = Nullch; /* other substr checked before this */
char *check_at = Nullch; /* check substr found at this pos */
#ifdef DEBUGGING
- char *i_strpos = strpos;
- SV *dsv = PERL_DEBUG_PAD_ZERO(0);
+ const char * const i_strpos = strpos;
+ SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
#endif
RX_MATCH_UTF8_set(prog,do_utf8);
|| ((slen = SvCUR(check)) > 1
&& memNE(SvPVX_const(check), s, slen)))
goto report_neq;
+ check_at = s;
goto success_at_start;
}
}
if (check == (do_utf8 ? prog->float_utf8 : prog->float_substr)) {
do_other_anchored:
{
- char *last = HOP3c(s, -start_shift, strbeg), *last1, *last2;
+ char * const last = HOP3c(s, -start_shift, strbeg);
+ char *last1, *last2;
char *s1 = s;
SV* must;
regstclass does not come from lookahead... */
/* If regstclass takes bytelength more than 1: If charlength==1, OK.
This leaves EXACTF only, which is dealt with in find_byclass(). */
- const U8* str = (U8*)STRING(prog->regstclass);
+ const U8* const str = (U8*)STRING(prog->regstclass);
const int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
- ? CHR_DIST(str+STR_LEN(prog->regstclass), str)
+ ? CHR_DIST((U8 *)str+STR_LEN(prog->regstclass),
+ (U8 *)str)
: 1);
const char * const endpos = (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
? HOP3c(s, (prog->minlen ? cl_l : 0), strend)
U8 *sm = (U8 *) m;
U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
+ const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE,
- 0, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+ 0, uniflags);
c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
- 0, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+ 0, uniflags);
lnc = 0;
while (sm < ((U8 *) m + ln)) {
lnc++;
UV c, f;
U8 tmpbuf [UTF8_MAXBYTES+1];
STRLEN len, foldlen;
-
+ const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
if (c1 == c2) {
/* Upper and lower of 1st char are equal -
* probably not a "letter". */
while (s <= e) {
c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY);
+ uniflags);
if ( c == c1
&& (ln == len ||
ibcmp_utf8(s, (char **)0, 0, do_utf8,
else {
while (s <= e) {
c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY);
+ uniflags);
/* Handle some of the three Greek sigmas cases.
* Note that not all the possible combinations
#if 0
I32 firstcp = PL_savestack_ix;
#endif
- const register bool do_utf8 = PL_reg_match_utf8;
+ register const bool do_utf8 = PL_reg_match_utf8;
#ifdef DEBUGGING
SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
#endif
+ U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
#ifdef DEBUGGING
PL_regindent++;
else
nextchr = UCHARAT(++locinput);
break;
-
case EXACT:
s = STRING(scan);
ln = STR_LEN(scan);
sayNO;
if (NATIVE_TO_UNI(*(U8*)s) !=
utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY))
+ uniflags))
sayNO;
l += ulen;
s ++;
sayNO;
if (NATIVE_TO_UNI(*((U8*)l)) !=
utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY))
+ uniflags))
sayNO;
s += ulen;
l ++;
else {
const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
- ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
+ ln = utf8n_to_uvchr((U8 *)r, UTF8SKIP(r), 0, 0);
}
if (OP(scan) == BOUND || OP(scan) == NBOUND) {
ln = isALNUM_uni(ln);
to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY);
+ uniflags);
c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY);
+ uniflags);
}
else {
c2 = c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY);
+ uniflags);
}
}
}
while (locinput <= e &&
utf8n_to_uvchr((U8*)locinput,
UTF8_MAXBYTES, &len,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY) != (UV)c1) {
+ uniflags) != (UV)c1) {
locinput += len;
count++;
}
while (locinput <= e) {
UV c = utf8n_to_uvchr((U8*)locinput,
UTF8_MAXBYTES, &len,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY);
+ uniflags);
if (c == (UV)c1 || c == (UV)c2)
break;
locinput += len;
if (do_utf8)
c = utf8n_to_uvchr((U8*)PL_reginput,
UTF8_MAXBYTES, 0,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY);
+ uniflags);
else
c = UCHARAT(PL_reginput);
/* If it could work, try it. */
if (do_utf8)
c = utf8n_to_uvchr((U8*)PL_reginput,
UTF8_MAXBYTES, 0,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY);
+ uniflags);
else
c = UCHARAT(PL_reginput);
}
if (do_utf8)
c = utf8n_to_uvchr((U8*)PL_reginput,
UTF8_MAXBYTES, 0,
- ckWARN(WARN_UTF8) ?
- 0 : UTF8_ALLOW_ANY);
+ uniflags);
else
c = UCHARAT(PL_reginput);
}
{
SV *prop = sv_newmortal();
- regprop(prop, p);
+ regprop(prop, (regnode *)p);
PerlIO_printf(Perl_debug_log,
"%*s %s can match %"IVdf" times out of %"IVdf"...\n",
REPORT_CODE_OFF+1, "", SvPVX_const(prop),(IV)c,(IV)max);
const U32 n = ARG(node);
if (PL_regdata->what[n] == 's') {
- SV *rv = (SV*)PL_regdata->data[n];
- AV *av = (AV*)SvRV((SV*)rv);
- SV **ary = AvARRAY(av);
+ SV * const rv = (SV*)PL_regdata->data[n];
+ AV * const av = (AV*)SvRV((SV*)rv);
+ SV **const ary = AvARRAY(av);
SV **a, **b;
/* See the end of regcomp.c:S_reglass() for
* documentation of these array elements. */
si = *ary;
- a = SvTYPE(ary[1]) == SVt_RV ? &ary[1] : 0;
+ a = SvROK(ary[1]) ? &ary[1] : 0;
b = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
if (a)
STRLEN len = 0;
STRLEN plen;
- if (do_utf8 && !UTF8_IS_INVARIANT(c))
- c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
- ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+ if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
+ c = utf8n_to_uvchr((U8 *)p, UTF8_MAXBYTES, &len,
+ ckWARN(WARN_UTF8) ? UTF8_CHECK_ONLY :
+ UTF8_ALLOW_ANYUV|UTF8_CHECK_ONLY);
+ if (len == (STRLEN)-1)
+ Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
+ }
plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
if (do_utf8 || (flags & ANYOF_UNICODE)) {
match = TRUE;
if (!match) {
AV *av;
- SV *sw = regclass_swash(n, TRUE, 0, (SV**)&av);
+ SV * const sw = regclass_swash((regnode *)n, TRUE, 0, (SV**)&av);
if (sw) {
- if (swash_fetch(sw, p, do_utf8))
+ if (swash_fetch(sw, (U8 *)p, do_utf8))
match = TRUE;
else if (flags & ANYOF_FOLD) {
if (!match && lenp && av) {
I32 i;
-
for (i = 0; i <= av_len(av); i++) {
- SV* sv = *av_fetch(av, i, FALSE);
+ SV* const sv = *av_fetch(av, i, FALSE);
STRLEN len;
- const char *s = SvPV_const(sv, len);
+ const char * const s = SvPV_const(sv, len);
if (len <= plen && memEQ(s, (char*)p, len)) {
*lenp = len;
U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
STRLEN tmplen;
- to_utf8_fold(p, tmpbuf, &tmplen);
+ to_utf8_fold((U8 *)p, tmpbuf, &tmplen);
if (swash_fetch(sw, tmpbuf, do_utf8))
match = TRUE;
}
https://perl5.git.perl.org / perl5.git / blobdiff