*
**** Alterations to Henry's code are...
****
- **** Copyright (c) 1991-2001, Larry Wall
+ **** Copyright (c) 1991-2002, Larry Wall
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
#define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
#define HOPBACK(pos, off) ( \
- (UTF && PL_reg_match_utf8) \
+ (PL_reg_match_utf8) \
? reghopmaybe((U8*)pos, -off) \
: (pos - off >= PL_bostr) \
? (U8*)(pos - off) \
#define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
#define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim))
-#define LOAD_UTF8_CHARCLASS(a,b) STMT_START { if (!CAT2(PL_utf8_,a)) (void)CAT2(is_utf8_, a)((U8*)b); } STMT_END
+#define LOAD_UTF8_CHARCLASS(a,b) STMT_START { if (!CAT2(PL_utf8_,a)) { ENTER; save_re_context(); (void)CAT2(is_utf8_, a)((U8*)b); LEAVE; } } STMT_END
/* for use after a quantifier and before an EXACT-like node -- japhy */
#define JUMPABLE(rn) ( \
PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \
)
+/*
+ Search for mandatory following text node; for lookahead, the text must
+ follow but for lookbehind (rn->flags != 0) we skip to the next step.
+*/
#define FIND_NEXT_IMPT(rn) STMT_START { \
while (JUMPABLE(rn)) \
- if (OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
- PL_regkind[(U8)OP(rn)] == CURLY) \
+ if (OP(rn) == SUSPEND || PL_regkind[(U8)OP(rn)] == CURLY) \
rn = NEXTOPER(NEXTOPER(rn)); \
else if (OP(rn) == PLUS) \
rn = NEXTOPER(rn); \
+ else if (OP(rn) == IFMATCH) \
+ rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
else rn += NEXT_OFF(rn); \
} STMT_END
DEBUG_r({
char *s = PL_reg_match_utf8 ?
- sv_uni_display(dsv, sv, 60, 0) : strpos;
+ sv_uni_display(dsv, sv, 60, UNI_DISPLAY_REGEX) :
+ strpos;
int len = PL_reg_match_utf8 ?
strlen(s) : strend - strpos;
if (!PL_colorset)
switch (OP(c)) {
case ANYOF:
while (s < strend) {
- if (reginclass(c, (U8*)s, do_utf8)) {
+ STRLEN skip = do_utf8 ? UTF8SKIP(s) : 1;
+
+ if (reginclass(c, (U8*)s, do_utf8) ||
+ (ANYOF_FOLD_SHARP_S(c, s, strend) &&
+ /* The assignment of 2 is intentional:
+ * for the sharp s, the skip is 2. */
+ (skip = SHARP_S_SKIP)
+ )) {
if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
}
- else
- tmp = 1;
- s += do_utf8 ? UTF8SKIP(s) : 1;
+ else
+ tmp = 1;
+ s += skip;
}
break;
case CANY:
to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
- c1 = utf8_to_uvuni(tmpbuf1, 0);
- c2 = utf8_to_uvuni(tmpbuf2, 0);
+ c1 = utf8_to_uvchr(tmpbuf1, 0);
+ c2 = utf8_to_uvchr(tmpbuf2, 0);
}
else {
c1 = *(U8*)m;
c1 = *(U8*)m;
c2 = PL_fold_locale[c1];
do_exactf:
- e = strend - ln;
+ e = do_utf8 ? s + ln : strend - ln;
if (norun && e < s)
e = s; /* Due to minlen logic of intuit() */
* text of the node. The c1 and c2 are the first
* characters (though in Unicode it gets a bit
* more complicated because there are more cases
- * than just upper and lower: one is really supposed
- * to use the so-called folding case for case-insensitive
- * matching (called "loose matching" in Unicode). */
+ * than just upper and lower: one needs to use
+ * the so-called folding case for case-insensitive
+ * matching (called "loose matching" in Unicode).
+ * ibcmp_utf8() will do just that. */
if (do_utf8) {
UV c, f;
U8 tmpbuf [UTF8_MAXLEN+1];
U8 foldbuf[UTF8_MAXLEN_FOLD+1];
STRLEN len, foldlen;
-
- /* The ibcmp_utf8() uses to_uni_fold() which is more
- * correct folding for Unicode than using lowercase.
- * However, it doesn't work quite fully since the folding
- * is a one-to-many mapping and the regex optimizer is
- * unaware of this, so it may throw out good matches.
- * Fortunately, not getting this right is allowed
- * for Unicode Regular Expression Support level 1,
- * only one-to-one matching is required. --jhi */
-
+
if (c1 == c2) {
while (s <= e) {
c = utf8_to_uvchr((U8*)s, &len);
if ( c == c1
&& (ln == len ||
- !ibcmp_utf8(s, do_utf8, strend - s,
- m, UTF, ln))
+ ibcmp_utf8(s, (char **)0, 0, do_utf8,
+ m, (char **)0, ln, UTF))
&& (norun || regtry(prog, s)) )
goto got_it;
else {
uvchr_to_utf8(tmpbuf, c);
- to_utf8_fold(tmpbuf, foldbuf, &foldlen);
- f = utf8_to_uvchr(foldbuf, 0);
+ f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
if ( f != c
&& (f == c1 || f == c2)
&& (ln == foldlen ||
- !ibcmp_utf8((char *)foldbuf,
- do_utf8, foldlen,
- m, UTF, ln))
+ !ibcmp_utf8((char *) foldbuf,
+ (char **)0, foldlen, do_utf8,
+ m,
+ (char **)0, ln, UTF))
&& (norun || regtry(prog, s)) )
goto got_it;
}
c = utf8_to_uvchr((U8*)s, &len);
/* Handle some of the three Greek sigmas cases.
- * Note that not all the possible combinations
- * are handled here: some of them are handled
- * handled by the standard folding rules, and
- * some of them (the character class or ANYOF
- * cases) are handled during compiletime in
- * regexec.c:S_regclass(). */
+ * Note that not all the possible combinations
+ * are handled here: some of them are handled
+ * by the standard folding rules, and some of
+ * them (the character class or ANYOF cases)
+ * are handled during compiletime in
+ * regexec.c:S_regclass(). */
if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
if ( (c == c1 || c == c2)
&& (ln == len ||
- !ibcmp_utf8(s, do_utf8, strend - s,
- m, UTF, ln))
+ ibcmp_utf8(s, (char **)0, 0, do_utf8,
+ m, (char **)0, ln, UTF))
&& (norun || regtry(prog, s)) )
goto got_it;
else {
uvchr_to_utf8(tmpbuf, c);
- to_utf8_fold(tmpbuf, foldbuf, &foldlen);
- f = utf8_to_uvchr(foldbuf, 0);
+ f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
if ( f != c
&& (f == c1 || f == c2)
&& (ln == foldlen ||
- !ibcmp_utf8((char *)foldbuf,
- do_utf8, foldlen,
- m, UTF, ln))
+ !ibcmp_utf8((char *) foldbuf,
+ (char **)0, foldlen, do_utf8,
+ m,
+ (char **)0, ln, UTF))
&& (norun || regtry(prog, s)) )
goto got_it;
}
SV* oreplsv = GvSV(PL_replgv);
bool do_utf8 = DO_UTF8(sv);
#ifdef DEBUGGING
- SV *dsv = PERL_DEBUG_PAD_ZERO(0);
+ SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
+ SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
#endif
PL_regcc = 0;
}
DEBUG_r({
- char *s = do_utf8 ? sv_uni_display(dsv, sv, 60, 0) : startpos;
- int len = do_utf8 ? strlen(s) : strend - startpos;
+ char *s0 = UTF ?
+ pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60,
+ UNI_DISPLAY_REGEX) :
+ prog->precomp;
+ int len0 = UTF ? SvCUR(dsv0) : prog->prelen;
+ char *s1 = do_utf8 ? sv_uni_display(dsv1, sv, 60,
+ UNI_DISPLAY_REGEX) : startpos;
+ int len1 = do_utf8 ? SvCUR(dsv1) : strend - startpos;
if (!PL_colorset)
reginitcolors();
PerlIO_printf(Perl_debug_log,
- "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
+ "%sMatching REx%s `%s%*.*s%s%s' against `%s%.*s%s%s'\n",
PL_colors[4],PL_colors[5],PL_colors[0],
- prog->precomp,
+ len0, len0, s0,
PL_colors[1],
- (strlen(prog->precomp) > 60 ? "..." : ""),
+ len0 > 60 ? "..." : "",
PL_colors[0],
- (int)(len > 60 ? 60 : len),
- s, PL_colors[1],
- (len > 60 ? "..." : "")
+ (int)(len1 > 60 ? 60 : len1),
+ s1, PL_colors[1],
+ (len1 > 60 ? "..." : "")
);
});
strend = HOPc(strend, -(minlen - 1));
DEBUG_r({
SV *prop = sv_newmortal();
+ char *s0;
+ char *s1;
+ int len0;
+ int len1;
+
regprop(prop, c);
- PerlIO_printf(Perl_debug_log, "Matching stclass `%s' against `%s'\n", SvPVX(prop), UTF ? sv_uni_display(dsv, sv, 60, 0) : s);
+ s0 = UTF ?
+ pv_uni_display(dsv0, (U8*)SvPVX(prop), SvCUR(prop), 60,
+ UNI_DISPLAY_REGEX) :
+ SvPVX(prop);
+ len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
+ s1 = UTF ?
+ sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
+ len1 = UTF ? SvCUR(dsv1) : strend - s;
+ PerlIO_printf(Perl_debug_log,
+ "Matching stclass `%*.*s' against `%*.*s'\n",
+ len0, len0, s0,
+ len1, len1, s1);
});
if (find_byclass(prog, c, s, strend, startpos, 0))
goto got_it;
#define sayYES goto yes
#define sayNO goto no
+#define sayNO_ANYOF goto no_anyof
#define sayYES_FINAL goto yes_final
#define sayYES_LOUD goto yes_loud
#define sayNO_FINAL goto no_final
char *s0 =
do_utf8 ?
pv_uni_display(dsv0, (U8*)(locinput - pref_len),
- pref0_len, 60, 0) :
+ pref0_len, 60, UNI_DISPLAY_REGEX) :
locinput - pref_len;
int len0 = do_utf8 ? strlen(s0) : pref0_len;
char *s1 = do_utf8 ?
pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
- pref_len - pref0_len, 60, 0) :
+ pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
locinput - pref_len + pref0_len;
int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
char *s2 = do_utf8 ?
pv_uni_display(dsv2, (U8*)locinput,
- PL_regeol - locinput, 60, 0) :
+ PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
locinput;
int len2 = do_utf8 ? strlen(s2) : l;
PerlIO_printf(Perl_debug_log,
if (l >= PL_regeol)
sayNO;
if (NATIVE_TO_UNI(*(U8*)s) !=
- utf8_to_uvchr((U8*)l, &ulen))
+ utf8_to_uvuni((U8*)l, &ulen))
sayNO;
l += ulen;
s ++;
if (l >= PL_regeol)
sayNO;
if (NATIVE_TO_UNI(*((U8*)l)) !=
- utf8_to_uvchr((U8*)s, &ulen))
+ utf8_to_uvuni((U8*)s, &ulen))
sayNO;
s += ulen;
l ++;
s = STRING(scan);
ln = STR_LEN(scan);
- {
+ if (do_utf8 || UTF) {
+ /* Either target or the pattern are utf8. */
char *l = locinput;
- char *e = s + ln;
-
- if (do_utf8 != (UTF!=0)) {
- /* The target and the pattern have differing utf8ness. */
- STRLEN ulen1, ulen2;
- UV cs, cl;
-
- if (do_utf8) {
- /* The target is utf8, the pattern is not utf8. */
- while (s < e) {
- if (l >= PL_regeol)
- sayNO;
-
- cs = to_uni_fold(NATIVE_TO_UNI(*(U8*)s),
- (U8*)s, &ulen1);
- cl = utf8_to_uvchr((U8*)l, &ulen2);
-
- if (cs != cl) {
- cl = to_uni_fold(cl, (U8*)l, &ulen2);
- if (ulen1 != ulen2 || cs != cl)
- sayNO;
- }
- l += ulen1;
- s ++;
- }
- }
- else {
- /* The target is not utf8, the pattern is utf8. */
- while (s < e) {
- if (l >= PL_regeol)
- sayNO;
-
- cs = utf8_to_uvchr((U8*)s, &ulen1);
-
- cl = to_uni_fold(NATIVE_TO_UNI(*(U8*)l),
- (U8*)l, &ulen2);
-
- if (cs != cl) {
- cs = to_uni_fold(cs, (U8*)s, &ulen1);
- if (ulen1 != ulen2 || cs != cl)
- sayNO;
- }
- l ++;
- s += ulen1;
- }
- }
- locinput = l;
- nextchr = UCHARAT(locinput);
- break;
- }
-
- if (do_utf8 && UTF) {
- /* Both the target and the pattern are utf8. */
- while (s < e) {
- if (l >= PL_regeol)
- sayNO;
- if (UTF8SKIP(s) != UTF8SKIP(l) ||
- memNE(s, (char*)l, UTF8SKIP(s))) {
- U8 lfoldbuf[UTF8_MAXLEN_FOLD+1];
- STRLEN lfoldlen;
-
- /* Try one of them folded. */
-
- to_utf8_fold((U8*)l, lfoldbuf, &lfoldlen);
- if (UTF8SKIP(s) != lfoldlen ||
- memNE(s, (char*)lfoldbuf, lfoldlen)) {
- U8 sfoldbuf[UTF8_MAXLEN_FOLD+1];
- STRLEN sfoldlen;
-
- /* Try both of them folded. */
-
- to_utf8_fold((U8*)s, sfoldbuf, &sfoldlen);
- if (sfoldlen != lfoldlen ||
- memNE((char*)sfoldbuf,
- (char*)lfoldbuf, lfoldlen))
- sayNO;
- }
- }
- l += UTF8SKIP(l);
- s += UTF8SKIP(s);
- }
- locinput = l;
- nextchr = UCHARAT(locinput);
- break;
+ char *e = PL_regeol;
+
+ if (ibcmp_utf8(s, 0, ln, UTF,
+ l, &e, 0, do_utf8)) {
+ /* One more case for the sharp s:
+ * pack("U0U*", 0xDF) =~ /ss/i,
+ * the 0xC3 0x9F are the UTF-8
+ * byte sequence for the U+00DF. */
+ if (!(do_utf8 &&
+ toLOWER(s[0]) == 's' &&
+ ln >= 2 &&
+ toLOWER(s[1]) == 's' &&
+ (U8)l[0] == 0xC3 &&
+ e - l >= 2 &&
+ (U8)l[1] == 0x9F))
+ sayNO;
}
+ locinput = e;
+ nextchr = UCHARAT(locinput);
+ break;
}
/* Neither the target and the pattern are utf8. */
break;
case ANYOF:
if (do_utf8) {
- if (!reginclass(scan, (U8*)locinput, do_utf8))
- sayNO;
+ STRLEN inclasslen = PL_regeol - locinput;
+
+ if (!reginclasslen(scan, (U8*)locinput, &inclasslen, do_utf8))
+ sayNO_ANYOF;
if (locinput >= PL_regeol)
sayNO;
- locinput += PL_utf8skip[nextchr];
+ locinput += inclasslen;
nextchr = UCHARAT(locinput);
+ break;
}
else {
if (nextchr < 0)
nextchr = UCHARAT(locinput);
if (!reginclass(scan, (U8*)locinput, do_utf8))
- sayNO;
+ sayNO_ANYOF;
if (!nextchr && locinput >= PL_regeol)
sayNO;
nextchr = UCHARAT(++locinput);
+ break;
}
+ no_anyof:
+ /* If we might have the case of the German sharp s
+ * in a casefolding Unicode character class. */
+
+ if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
+ locinput += SHARP_S_SKIP;
+ nextchr = UCHARAT(locinput);
+ }
+ else
+ sayNO;
break;
case ALNUML:
PL_reg_flags |= RF_tainted;
n = regrepeat(scan, n);
locinput = PL_reginput;
if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
- (!PL_multiline || OP(next) == SEOL || OP(next) == EOS)) {
+ ((!PL_multiline && OP(next) != MEOL) ||
+ OP(next) == SEOL || OP(next) == EOS))
+ {
ln = n; /* why back off? */
/* ...because $ and \Z can match before *and* after
newline at the end. Consider "\n\n" =~ /\n+\Z\n/.
}
break;
case SANY:
- scan = loceol;
+ if (do_utf8) {
+ loceol = PL_regeol;
+ while (scan < loceol && hardcount < max) {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ }
+ else
+ scan = loceol;
break;
case CANY:
scan = loceol;
*/
SV *
-Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** initsvp)
+Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** listsvp, SV **altsvp)
{
- SV *sw = NULL;
- SV *si = NULL;
+ SV *sw = NULL;
+ SV *si = NULL;
+ SV *alt = NULL;
if (PL_regdata && PL_regdata->count) {
U32 n = ARG(node);
if (PL_regdata->what[n] == 's') {
SV *rv = (SV*)PL_regdata->data[n];
AV *av = (AV*)SvRV((SV*)rv);
- SV **a;
+ SV **a, **b;
- si = *av_fetch(av, 0, FALSE);
- a = av_fetch(av, 1, FALSE);
+ /* See the end of regcomp.c:S_reglass() for
+ * documentation of these array elements. */
+
+ si = *av_fetch(av, 0, FALSE);
+ a = av_fetch(av, 1, FALSE);
+ b = av_fetch(av, 2, FALSE);
if (a)
sw = *a;
sw = swash_init("utf8", "", si, 1, 0);
(void)av_store(av, 1, sw);
}
+ if (b)
+ alt = *b;
}
}
- if (initsvp)
- *initsvp = si;
+ if (listsvp)
+ *listsvp = si;
+ if (altsvp)
+ *altsvp = alt;
return sw;
}
/*
- - reginclass - determine if a character falls into a character class
+ - reginclasslen - determine if a character falls into a character class
+
+ The n is the ANYOF regnode, the p is the target string, lenp
+ is pointer to the maximum length of how far to go in the p
+ (if the lenp is zero, UTF8SKIP(p) is used),
+ do_utf8 tells whether the target string is in UTF-8.
+
*/
STATIC bool
-S_reginclass(pTHX_ register regnode *n, register U8* p, register bool do_utf8)
+S_reginclasslen(pTHX_ register regnode *n, register U8* p, STRLEN* lenp, register bool do_utf8)
{
char flags = ANYOF_FLAGS(n);
bool match = FALSE;
UV c;
STRLEN len = 0;
+ STRLEN plen;
c = do_utf8 ? utf8_to_uvchr(p, &len) : *p;
+ plen = lenp ? *lenp : UNISKIP(c);
if (do_utf8 || (flags & ANYOF_UNICODE)) {
+ if (lenp)
+ *lenp = 0;
if (do_utf8 && !ANYOF_RUNTIME(n)) {
if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
match = TRUE;
if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
match = TRUE;
if (!match) {
- SV *sw = regclass_swash(n, TRUE, 0);
+ AV *av;
+ SV *sw = regclass_swash(n, TRUE, 0, (SV**)&av);
if (sw) {
if (swash_fetch(sw, p, do_utf8))
match = TRUE;
else if (flags & ANYOF_FOLD) {
- STRLEN ulen;
- U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
-
- to_utf8_fold(p, tmpbuf, &ulen);
- if (swash_fetch(sw, tmpbuf, do_utf8))
- match = TRUE;
- to_utf8_upper(p, tmpbuf, &ulen);
- if (swash_fetch(sw, tmpbuf, do_utf8))
- match = TRUE;
+ if (!match && lenp && av) {
+ I32 i;
+
+ for (i = 0; i <= av_len(av); i++) {
+ SV* sv = *av_fetch(av, i, FALSE);
+ STRLEN len;
+ char *s = SvPV(sv, len);
+
+ if (len <= plen && memEQ(s, (char*)p, len)) {
+ *lenp = len;
+ match = TRUE;
+ break;
+ }
+ }
+ }
+ if (!match) {
+ U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
+ STRLEN tmplen;
+
+ to_utf8_fold(p, tmpbuf, &tmplen);
+ if (swash_fetch(sw, tmpbuf, do_utf8))
+ match = TRUE;
+ }
}
}
}
+ if (match && lenp && *lenp == 0)
+ *lenp = UNISKIP(c);
}
if (!match && c < 256) {
if (ANYOF_BITMAP_TEST(n, c))
return (flags & ANYOF_INVERT) ? !match : match;
}
+/*
+ - reginclass - determine if a character falls into a character class
+
+ The n is the ANYOF regnode, the p is the target string, do_utf8 tells
+ whether the target string is in UTF-8.
+
+ */
+
+STATIC bool
+S_reginclass(pTHX_ register regnode *n, register U8* p, register bool do_utf8)
+{
+ return S_reginclasslen(aTHX_ n, p, 0, do_utf8);
+}
+
STATIC U8 *
S_reghop(pTHX_ U8 *s, I32 off)
{