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

diff --git a/regcomp.c b/regcomp.c
index a3106dc..89b3e53 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -298,8 +298,6 @@ STATIC void
 S_cl_and(pTHX_ struct regnode_charclass_class *cl,
 	 struct regnode_charclass_class *and_with)
 {
-    int value;
-
     if (!(and_with->flags & ANYOF_CLASS)
 	&& !(cl->flags & ANYOF_CLASS)
 	&& (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
@@ -323,8 +321,6 @@ S_cl_and(pTHX_ struct regnode_charclass_class *cl,
 STATIC void
 S_cl_or(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with)
 {
-    int value;
-
     if (or_with->flags & ANYOF_INVERT) {
 	/* We do not use
 	 * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
@@ -602,7 +598,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
 		    && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan))
 		    && (!(data->start_class->flags & ANYOF_FOLD)
 			|| !ANYOF_BITMAP_TEST(data->start_class,
-					      PL_fold[*STRING(scan)])))
+					      PL_fold[*(U8*)STRING(scan)])))
 		    compat = 0;
 		ANYOF_CLASS_ZERO(data->start_class);
 		ANYOF_BITMAP_ZERO(data->start_class);
@@ -644,7 +640,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
 		if (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE)) 
 		    && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan))
 		    && !ANYOF_BITMAP_TEST(data->start_class, 
-					  PL_fold[*STRING(scan)]))
+					  PL_fold[*(U8*)STRING(scan)]))
 		    compat = 0;
 		ANYOF_CLASS_ZERO(data->start_class);
 		ANYOF_BITMAP_ZERO(data->start_class);
@@ -771,9 +767,9 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
 		    Perl_warner(aTHX_ WARN_REGEXP,
 				"Strange *+?{} on zero-length expression");
 		min += minnext * mincount;
-		is_inf_internal |= (maxcount == REG_INFTY 
-				    && (minnext + deltanext) > 0
-				   || deltanext == I32_MAX);
+		is_inf_internal |= ((maxcount == REG_INFTY 
+				     && (minnext + deltanext) > 0)
+				    || deltanext == I32_MAX);
 		is_inf |= is_inf_internal;
 		delta += (minnext + deltanext) * maxcount - minnext * mincount;
 
@@ -1226,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);
@@ -1234,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);
@@ -1326,9 +1323,6 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     dTHR;
     register regexp *r;
     regnode *scan;
-    SV **longest;
-    SV *longest_fixed;
-    SV *longest_float;
     regnode *first;
     I32 flags;
     I32 minlen = 0;
@@ -1366,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;
@@ -1735,6 +1732,11 @@ S_reg(pTHX_ I32 paren, I32 *flagp)
 		*flagp = TRYAGAIN;
 		return NULL;
 	    case 'p':
+		if (SIZE_ONLY)
+		    Perl_warner(aTHX_ WARN_REGEXP,
+				"(?p{}) is deprecated - use (??{})");
+		/* FALL THROUGH*/
+	    case '?':
 		logical = 1;
 		paren = *PL_regcomp_parse++;
 		/* FALL THROUGH */
@@ -2294,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);
@@ -2597,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;
 				}
@@ -2608,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;
 			}
@@ -2621,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;
 			}
@@ -2820,12 +2832,12 @@ S_regpposixcc(pTHX_ I32 value)
 			}
 			break;
 		    }
-		    if ((namedclass == OOB_NAMEDCLASS ||
-			 !(posixcc + skip + 2 < PL_regxend &&
-			   (posixcc[skip] == ':' &&
-			    posixcc[skip + 1] == ']'))))
-			Perl_croak(aTHX_ "Character class [:%.*s:] unknown",
-				   t - s - 1, s + 1); 
+		    if (namedclass == OOB_NAMEDCLASS ||
+			posixcc[skip] != ':' ||
+			posixcc[skip+1] != ']')
+			Perl_croak(aTHX_
+				   "Character class [:%.*s:] unknown",
+				   t - s - 1, s + 1);
 		} else if (ckWARN(WARN_REGEXP) && !SIZE_ONLY)
 		    /* [[=foo=]] and [[.foo.]] are still future. */
 		    Perl_warner(aTHX_ WARN_REGEXP,
@@ -2867,11 +2879,10 @@ STATIC regnode *
 S_regclass(pTHX)
 {
     dTHR;
-    register UV value;
+    register U32 value;
     register I32 lastvalue = OOB_CHAR8;
     register I32 range = 0;
     register regnode *ret;
-    register I32 def;
     I32 numlen;
     I32 namedclass;
     char *rangebegin;
@@ -2911,6 +2922,8 @@ S_regclass(pTHX)
 	    namedclass = regpposixcc(value);
 	else if (value == '\\') {
 	    value = UCHARAT(PL_regcomp_parse++);
+	    /* Some compilers cannot handle switching on 64-bit integer
+	     * values, therefore value cannot be an UV. --jhi */
 	    switch (value) {
 	    case 'w':	namedclass = ANYOF_ALNUM;	break;
 	    case 'W':	namedclass = ANYOF_NALNUM;	break;
@@ -2931,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;
@@ -2940,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;
@@ -3312,7 +3327,7 @@ S_regclassutf8(pTHX)
 {
     dTHR;
     register char *e;
-    register UV value;
+    register U32 value;
     register U32 lastvalue = OOB_UTF8;
     register I32 range = 0;
     register regnode *ret;
@@ -3353,8 +3368,11 @@ S_regclassutf8(pTHX)
 	if (value == '[')
 	    namedclass = regpposixcc(value);
 	else if (value == '\\') {
-	    value = utf8_to_uv((U8*)PL_regcomp_parse, &numlen);
+	    value = (U32)utf8_to_uv((U8*)PL_regcomp_parse, &numlen);
 	    PL_regcomp_parse += numlen;
+	    /* Some compilers cannot handle switching on 64-bit integer
+	     * values, therefore value cannot be an UV.  Yes, this will
+	     * be a problem later if we want switch on Unicode.  --jhi */
 	    switch (value) {
 	    case 'w':		namedclass = ANYOF_ALNUM;		break;
 	    case 'W':		namedclass = ANYOF_NALNUM;		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;
@@ -3646,7 +3667,7 @@ S_reguni(pTHX_ UV uv, char* s, I32* lenp)
 {
     dTHR;
     if (SIZE_ONLY) {
-	U8 tmpbuf[10];
+	U8 tmpbuf[UTF8_MAXLEN];
 	*lenp = uv_to_utf8(tmpbuf, uv) - tmpbuf;
     }
     else
@@ -3696,7 +3717,6 @@ S_regtail(pTHX_ regnode *p, regnode *val)
     dTHR;
     register regnode *scan;
     register regnode *temp;
-    register I32 offset;
 
     if (SIZE_ONLY)
 	return;
@@ -3765,7 +3785,7 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
 {
 #ifdef DEBUGGING
     register U8 op = EXACT;	/* Arbitrary non-END op. */
-    register regnode *next, *onode;
+    register regnode *next;
 
     while (op != END && (!last || node < last)) {
 	/* While that wasn't END last time... */