diff options
| -rw-r--r-- | embed.h | 2 | ||||
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rw-r--r-- | pod/perlapi.pod | 7 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | regexec.c | 48 | ||||
| -rw-r--r-- | utf8.c | 41 |
6 files changed, 58 insertions, 44 deletions
@@ -1814,7 +1814,7 @@ #define hv_undef(a) Perl_hv_undef(aTHX_ a) #define ibcmp(a,b,c) Perl_ibcmp(aTHX_ a,b,c) #define ibcmp_locale(a,b,c) Perl_ibcmp_locale(aTHX_ a,b,c) -#define ibcmp_utf8(a,b,c,d,e,f) Perl_ibcmp_utf8(aTHX_ a,b,c,d,e,f) +#define ibcmp_utf8(a,b,c,d,e,f,g,h) Perl_ibcmp_utf8(aTHX_ a,b,c,d,e,f,g,h) #define ingroup(a,b) Perl_ingroup(aTHX_ a,b) #define init_argv_symbols(a,b) Perl_init_argv_symbols(aTHX_ a,b) #define init_debugger() Perl_init_debugger(aTHX) @@ -1333,7 +1333,7 @@ Apd |HE* |hv_store_ent |HV* tb|SV* key|SV* val|U32 hash Apd |void |hv_undef |HV* tb Ap |I32 |ibcmp |const char* a|const char* b|I32 len Ap |I32 |ibcmp_locale |const char* a|const char* b|I32 len -Apd |I32 |ibcmp_utf8 |const char* a|bool ua|I32 len1|const char* b|bool ub|I32 len2 +Apd |I32 |ibcmp_utf8 |const char* a|I32 len1|bool u1|char **ae|const char* b|I32 len2|bool u2|char **be p |bool |ingroup |Gid_t testgid|Uid_t effective p |void |init_argv_symbols|int|char ** p |void |init_debugger diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 6228c75f21..44669f582d 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -1139,7 +1139,12 @@ For case-insensitiveness, the "casefolding" of Unicode is used instead of upper/lowercasing both the characters, see http://www.unicode.org/unicode/reports/tr21/ (Case Mappings). - I32 ibcmp_utf8(const char* a, bool ua, I32 len1, const char* b, bool ub, I32 len2) +If either length is (STRLEN)-1 the scan will continue until a match is +found. If both lengths are (STRLEN)-1, true is returned (as a sign of +non-match). In the case of a match, the f1 and f2 are updated to record +how far the comparison proceeded. + + I32 ibcmp_utf8(const char* a, I32 len1, bool u1, char **ae, const char* b, I32 len2, bool u2, char **be) =for hackers Found in file utf8.c @@ -315,7 +315,7 @@ PERL_CALLCONV HE* Perl_hv_store_ent(pTHX_ HV* tb, SV* key, SV* val, U32 hash); PERL_CALLCONV void Perl_hv_undef(pTHX_ HV* tb); PERL_CALLCONV I32 Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len); PERL_CALLCONV I32 Perl_ibcmp_locale(pTHX_ const char* a, const char* b, I32 len); -PERL_CALLCONV I32 Perl_ibcmp_utf8(pTHX_ const char* a, bool ua, I32 len1, const char* b, bool ub, I32 len2); +PERL_CALLCONV I32 Perl_ibcmp_utf8(pTHX_ const char* a, I32 len1, bool u1, char **ae, const char* b, I32 len2, bool u2, char **be); PERL_CALLCONV bool Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective); PERL_CALLCONV void Perl_init_argv_symbols(pTHX_ int, char **); PERL_CALLCONV void Perl_init_debugger(pTHX); @@ -980,31 +980,25 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta U8 tmpbuf [UTF8_MAXLEN+1]; U8 foldbuf[UTF8_MAXLEN_FOLD+1]; STRLEN len, foldlen; - STRLEN mlen = utf8_length((U8*)m, (U8*)(m + ln)); - U8* l; /* The last byte of the last character in s. */ if (c1 == c2) { while (s <= e) { c = utf8_to_uvchr((U8*)s, &len); - l = utf8_hop((U8*)s, mlen); if ( c == c1 && (ln == len || - !ibcmp_utf8(s, do_utf8, - l - (U8*)s, - m, UTF, ln)) + !ibcmp_utf8(s, (STRLEN)-1, do_utf8, 0, + m, ln, UTF, 0)) && (norun || regtry(prog, s)) ) goto got_it; else { uvchr_to_utf8(tmpbuf, c); f = to_utf8_fold(tmpbuf, foldbuf, &foldlen); - l = utf8_hop(foldbuf, mlen); if ( f != c && (f == c1 || f == c2) && (ln == foldlen || !ibcmp_utf8((char *)foldbuf, - do_utf8, - l - foldbuf, - m, UTF, ln)) + (STRLEN)-1, do_utf8, 0, + m, ln, UTF, 0)) && (norun || regtry(prog, s)) ) goto got_it; } @@ -1014,7 +1008,6 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta else { while (s <= e) { c = utf8_to_uvchr((U8*)s, &len); - l = utf8_hop((U8*)s, mlen); /* Handle some of the three Greek sigmas cases. * Note that not all the possible combinations @@ -1029,22 +1022,19 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta if ( (c == c1 || c == c2) && (ln == len || - !ibcmp_utf8(s, do_utf8, - l - (U8*)s, - m, UTF, ln)) + !ibcmp_utf8(s, (STRLEN)-1, do_utf8, 0, + m, ln, UTF, 0)) && (norun || regtry(prog, s)) ) goto got_it; else { uvchr_to_utf8(tmpbuf, c); f = to_utf8_fold(tmpbuf, foldbuf, &foldlen); - l = utf8_hop(foldbuf, mlen); if ( f != c && (f == c1 || f == c2) && (ln == foldlen || !ibcmp_utf8((char *)foldbuf, - do_utf8, - l - foldbuf, - m, UTF, ln)) + (STRLEN)-1, do_utf8, 0, + m, ln, UTF, 0)) && (norun || regtry(prog, s)) ) goto got_it; } @@ -2352,16 +2342,10 @@ S_regmatch(pTHX_ regnode *prog) if (do_utf8 || UTF) { /* Either target or the pattern are utf8. */ - STRLEN slen = utf8_length((U8*)s, (U8*)e); - char *lend = (char *)utf8_hop((U8*)l, slen); - if (ibcmp_utf8(s, TRUE, e - s, - l, TRUE, lend - l)) + if (ibcmp_utf8(s, e - s, TRUE, 0, + l, (STRLEN)-1, TRUE, &l)) sayNO; - else { - l = lend; - s = e; - } locinput = l; nextchr = UCHARAT(locinput); break; @@ -4183,14 +4167,14 @@ S_reginclass(pTHX_ register regnode *n, register U8* p, register bool do_utf8) if (swash_fetch(sw, p, do_utf8)) match = TRUE; else if (flags & ANYOF_FOLD) { - STRLEN ulen; - U8 tmpbuf[UTF8_MAXLEN_FOLD+1]; + U8 foldbuf[UTF8_MAXLEN_FOLD+1]; + STRLEN foldlen; - to_utf8_fold(p, tmpbuf, &ulen); - if (swash_fetch(sw, tmpbuf, do_utf8)) + to_utf8_fold(p, foldbuf, &foldlen); + if (swash_fetch(sw, foldbuf, do_utf8)) match = TRUE; - to_utf8_upper(p, tmpbuf, &ulen); - if (swash_fetch(sw, tmpbuf, do_utf8)) + to_utf8_upper(p, foldbuf, &foldlen); + if (swash_fetch(sw, foldbuf, do_utf8)) match = TRUE; } } @@ -1707,7 +1707,7 @@ Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags) } /* -=for apidoc A|I32|ibcmp_utf8|const char *s1|bool u1|register I32 len1|const char *s2|bool u2|register I32 len2 +=for apidoc A|I32|ibcmp_utf8|const char *s1|register I32 len1|bool u1|char **f1|const char *s2|register I32 len2|bool u2|char **f2 Return true if the strings s1 and s2 differ case-insensitively, false if not (if they are equal case-insensitively). If u1 is true, the @@ -1718,21 +1718,36 @@ For case-insensitiveness, the "casefolding" of Unicode is used instead of upper/lowercasing both the characters, see http://www.unicode.org/unicode/reports/tr21/ (Case Mappings). +If either length is (STRLEN)-1 the scan will continue until a match is +found. If both lengths are (STRLEN)-1, true is returned (as a sign of +non-match). In the case of a match, the f1 and f2 are updated to record +how far the comparison proceeded. + =cut */ I32 -Perl_ibcmp_utf8(pTHX_ const char *s1, bool u1, register I32 len1, const char *s2, bool u2, register I32 len2) +Perl_ibcmp_utf8(pTHX_ const char *s1, register I32 len1, bool u1, char **f1, const char *s2, register I32 len2, bool u2, char **f2) { - register U8 *p1 = (U8*)s1, *q1 = 0; - register U8 *p2 = (U8*)s2, *q2 = 0; - register U8 *e1 = p1 + len1; - register U8 *e2 = p2 + len2; + register U8 *p1 = (U8*)s1; + register U8 *p2 = (U8*)s2; + register U8 *e1, *q1 = 0; + register U8 *e2, *q2 = 0; STRLEN l1 = 0, l2 = 0; U8 foldbuf1[UTF8_MAXLEN_FOLD+1]; U8 foldbuf2[UTF8_MAXLEN_FOLD+1]; U8 natbuf[1+1]; STRLEN foldlen1, foldlen2; + bool inf1, inf2, match; - while (p1 < e1 && p2 < e2) { + inf1 = len1 == (STRLEN)-1; + inf2 = len2 == (STRLEN)-1; + if (inf1 && inf2) + return 1; /* mismatch */ + if (!inf1) + e1 = p1 + len1; + if (!inf2) + e2 = p2 + len2; + + while ((p1 < e1 || inf1) && (p2 < e2 || inf2)) { if (l1 == 0) { if (u1) to_utf8_fold(p1, foldbuf1, &foldlen1); @@ -1768,6 +1783,16 @@ Perl_ibcmp_utf8(pTHX_ const char *s1, bool u1, register I32 len1, const char *s2 p2 += u2 ? UTF8SKIP(p2) : 1; } - return p1 == e1 && p2 == e2 ? 0 : 1; /* 0 match, 1 mismatch */ + + match = (inf1 ? 1 : p1 == e1) && (inf2 ? 1 : p2 == e2); + + if (match) { + if (f1) + *f1 = (char *)p1; + if (f2) + *f2 = (char *)p2; + } + + return match ? 0 : 1; /* 0 match, 1 mismatch */ } |