Make ibcmp_utf8() optionally progress in either string for

as long as it takes and optionally record how far it got.

p4raw-id: //depot/perl@14010

6 files changed, 58 insertions, 44 deletions

diff --git a/embed.h b/embed.h
index 273e199a4c..7a8e421ca1 100644
--- a/embed.h
+++ b/embed.h
@@ -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)
diff --git a/embed.pl b/embed.pl
index 67d7d0cce9..929b0146c7 100755
--- a/embed.pl
+++ b/embed.pl
@@ -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
diff --git a/proto.h b/proto.h
index 9ef7a7ac3c..f95f0476df 100644
--- a/proto.h
+++ b/proto.h
@@ -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);
diff --git a/regexec.c b/regexec.c
index 4bddbf32da..c189b14470 100644
--- a/regexec.c
+++ b/regexec.c
@@ -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;
 		}
 	    }
diff --git a/utf8.c b/utf8.c
index 81711e7f30..a59b1ed523 100644
--- a/utf8.c
+++ b/utf8.c
@@ -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 */
 }