X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regcomp.c;h=89b3e53babf8e82478dc2c5743a720dbb8f477d1;hb=be26652545762cccb4c0118f022cf9d0ec20cf93;hp=9768d18c9367b1b961795cfccb66c7b8f84d3259;hpb=155aba94f677ac771761a1f510964fe5b21524ed;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/regcomp.c b/regcomp.c
index 9768d18..89b3e53 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -1222,7 +1222,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
 		if (data)
 		    data->flags |= SF_HAS_EVAL;
 	}
-	else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded */
+	else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
 		if (flags & SCF_DO_SUBSTR) {
 		    scan_commit(data);
 		    data->longest = &(data->longest_float);
@@ -1230,6 +1230,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
 		is_inf = is_inf_internal = 1;
 		if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
 		    cl_anything(data->start_class);
+		flags &= ~SCF_DO_STCLASS;
 	}
 	/* Else: zero-length, ignore. */
 	scan = regnext(scan);
@@ -1359,7 +1360,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     PL_regsize = 0L;
     PL_regcode = &PL_regdummy;
     PL_reg_whilem_seen = 0;
+#if 0 /* REGC() is (currently) a NOP at the first pass.
+       * Clever compilers notice this and complain. --jhi */
     REGC((U8)REG_MAGIC, (char*)PL_regcode);
+#endif
     if (reg(0, &flags) == NULL) {
 	Safefree(PL_regprecomp);
 	PL_regprecomp = Nullch;
@@ -1728,7 +1732,9 @@ S_reg(pTHX_ I32 paren, I32 *flagp)
 		*flagp = TRYAGAIN;
 		return NULL;
 	    case 'p':
-		Perl_warner(aTHX_ WARN_REGEXP, "(?p{}) is deprecated - use (??{})");
+		if (SIZE_ONLY)
+		    Perl_warner(aTHX_ WARN_REGEXP,
+				"(?p{}) is deprecated - use (??{})");
 		/* FALL THROUGH*/
 	    case '?':
 		logical = 1;
@@ -2290,8 +2296,14 @@ tryagain:
 	nextchar();
 	ret = reg(1, &flags);
 	if (ret == NULL) {
-		if (flags & TRYAGAIN)
+		if (flags & TRYAGAIN) {
+		    if (PL_regcomp_parse == PL_regxend) {
+			 /* Make parent create an empty node if needed. */
+			*flagp |= TRYAGAIN;
+			return(NULL);
+		    }
 		    goto tryagain;
+		}
 		return(NULL);
 	}
 	*flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
@@ -2593,8 +2605,10 @@ tryagain:
 			    if (!e)
 				FAIL("Missing right brace on \\x{}");
 			    else if (UTF) {
-				ender = (UV)scan_hex(p + 1, e - p, &numlen);
-				if (numlen + len >= 127) {	/* numlen is generous */
+				numlen = 1;	/* allow underscores */
+				ender = (UV)scan_hex(p + 1, e - p - 1, &numlen);
+				/* numlen is generous */
+				if (numlen + len >= 127) {
 				    p--;
 				    goto loopdone;
 				}
@@ -2604,6 +2618,7 @@ tryagain:
 				FAIL("Can't use \\x{} without 'use utf8' declaration");
 			}
 			else {
+			    numlen = 0;		/* disallow underscores */
 			    ender = (UV)scan_hex(p, 2, &numlen);
 			    p += numlen;
 			}
@@ -2617,6 +2632,7 @@ tryagain:
 		    case '5': case '6': case '7': case '8':case '9':
 			if (*p == '0' ||
 			  (isDIGIT(p[1]) && atoi(p) >= PL_regnpar) ) {
+			    numlen = 0;		/* disallow underscores */
 			    ender = (UV)scan_oct(p, 3, &numlen);
 			    p += numlen;
 			}
@@ -2928,6 +2944,7 @@ S_regclass(pTHX)
 	    case 'a':	value = '\057';			break;
 #endif
 	    case 'x':
+		numlen = 0;		/* disallow underscores */
 		value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen);
 		PL_regcomp_parse += numlen;
 		break;
@@ -2937,6 +2954,7 @@ S_regclass(pTHX)
 		break;
 	    case '0': case '1': case '2': case '3': case '4':
 	    case '5': case '6': case '7': case '8': case '9':
+		numlen = 0;		/* disallow underscores */
 		value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen);
 		PL_regcomp_parse += numlen;
 		break;
@@ -3402,12 +3420,14 @@ S_regclassutf8(pTHX)
 		    e = strchr(PL_regcomp_parse++, '}');
                     if (!e)
                         FAIL("Missing right brace on \\x{}");
+		    numlen = 1;		/* allow underscores */
 		    value = (UV)scan_hex(PL_regcomp_parse,
 				     e - PL_regcomp_parse,
 				     &numlen);
 		    PL_regcomp_parse = e + 1;
 		}
 		else {
+		    numlen = 0;		/* disallow underscores */
 		    value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen);
 		    PL_regcomp_parse += numlen;
 		}
@@ -3418,6 +3438,7 @@ S_regclassutf8(pTHX)
 		break;
 	    case '0': case '1': case '2': case '3': case '4':
 	    case '5': case '6': case '7': case '8': case '9':
+		numlen = 0;		/* disallow underscores */
 		value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen);
 		PL_regcomp_parse += numlen;
 		break;