X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regexec.c;h=13cc68bf494faf9cb12d03c7e268f31a29dc9981;hb=5c284bb074748eab0ba4ff8e53eb1eeeb0f7a962;hp=f302259fcc191657e3bf339a6edefad66a723586;hpb=a02a5408b2f199007c4dcb74559cc79066307ada;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/regexec.c b/regexec.c
index f302259..13cc68b 100644
--- a/regexec.c
+++ b/regexec.c
@@ -416,8 +416,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     char *check_at = Nullch;		/* check substr found at this pos */
     const I32 multiline = prog->reganch & PMf_MULTILINE;
 #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
 
     GET_RE_DEBUG_FLAGS_DECL;
@@ -518,6 +518,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 		     || ((slen = SvCUR(check)) > 1
 			 && memNE(SvPVX_const(check), s, slen)))
 		goto report_neq;
+	    check_at = s;
 	    goto success_at_start;
 	  }
 	}
@@ -615,7 +616,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 	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;
 
@@ -861,7 +863,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 	   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)
 		    : 1);
@@ -1038,14 +1040,15 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32
 		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++;
@@ -1084,14 +1087,13 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32
 	        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,
@@ -1118,8 +1120,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32
 		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
@@ -2407,7 +2408,7 @@ S_regmatch(pTHX_ regnode *prog)
 #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);
@@ -2415,6 +2416,7 @@ S_regmatch(pTHX_ regnode *prog)
 
     SV *re_debug_flags = NULL;
 #endif
+    U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
 
     GET_RE_DEBUG_FLAGS;
 
@@ -2582,8 +2584,6 @@ S_regmatch(pTHX_ regnode *prog)
 	case TRIEF:
 	case TRIEFL:
 	    {
-
-		const U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY;
 		U8 *uc = ( U8* )locinput;
 		U32 state = 1;
 		U16 charid = 0;
@@ -2612,7 +2612,7 @@ S_regmatch(pTHX_ regnode *prog)
 
 		    if ( base ) {
 
-			if ( do_utf8 || UTF ) {
+			if ( do_utf8 ) {
 			    if ( foldlen>0 ) {
 				uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );
 				foldlen -= len;
@@ -2651,7 +2651,6 @@ S_regmatch(pTHX_ regnode *prog)
 	       from previous if blocks */
 	case TRIE:
 	    {
-		const U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY;
 		U8 *uc = (U8*)locinput;
 		U32 state = 1;
 		U16 charid = 0;
@@ -2678,7 +2677,7 @@ S_regmatch(pTHX_ regnode *prog)
 
 		    if ( base ) {
 
-			if ( do_utf8 || UTF ) {
+			if ( do_utf8 ) {
 			    uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
 			} else {
 			    uvc = (U32)*uc;
@@ -2807,8 +2806,7 @@ S_regmatch(pTHX_ regnode *prog)
 			     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 ++;
@@ -2822,8 +2820,7 @@ S_regmatch(pTHX_ regnode *prog)
 			    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 ++;
@@ -3940,16 +3937,13 @@ S_regmatch(pTHX_ regnode *prog)
 			     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);
 			}
 		    }
 		}
@@ -4010,8 +4004,7 @@ S_regmatch(pTHX_ regnode *prog)
 				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++;
 				}
@@ -4022,8 +4015,7 @@ S_regmatch(pTHX_ regnode *prog)
 				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;
@@ -4059,8 +4051,7 @@ S_regmatch(pTHX_ regnode *prog)
 			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. */
@@ -4109,8 +4100,7 @@ S_regmatch(pTHX_ regnode *prog)
 			    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);
 			}
@@ -4132,8 +4122,7 @@ S_regmatch(pTHX_ regnode *prog)
 			    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);
 			}
@@ -4670,16 +4659,16 @@ Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsv
 	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
+	    /* See the end of regcomp.c:S_regclass() 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)
@@ -4721,9 +4710,13 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp
     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(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)) {
@@ -4737,7 +4730,7 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp
 	    match = TRUE;
 	if (!match) {
 	    AV *av;
-	    SV *sw = regclass_swash(n, TRUE, 0, (SV**)&av);
+	    SV * const sw = regclass_swash(n, TRUE, 0, (SV**)&av);
 	
 	    if (sw) {
 		if (swash_fetch(sw, p, do_utf8))
@@ -4745,11 +4738,10 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp
 		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;