X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regcomp.c;h=96bafd3162f03ce033d5e9fdec725b15e47e7e8d;hb=f1c09d8aea4b00e7799b7273c877df50e0fd657a;hp=3d75a484f54c60ddefd294546355d55d2af052d2;hpb=7a799e204b140f54600dab7d4a7b8f748e814b8f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/regcomp.c b/regcomp.c
index 3d75a48..96bafd3 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -2881,7 +2881,7 @@ tryagain:
 		    if (!RExC_end) {
 			RExC_parse += 2;
 			RExC_end = oldregxend;
-			vFAIL("Missing right brace on \\p{}");
+			vFAIL2("Missing right brace on \\%c{}", UCHARAT(RExC_parse - 2));
 		    }
 		    RExC_end++;
 		}
@@ -3039,7 +3039,8 @@ tryagain:
 				vFAIL("Missing right brace on \\x{}");
 			    }
 			    else {
-                                I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
+                                I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
+                                    | PERL_SCAN_DISALLOW_PREFIX;
                                 numlen = e - p - 1;
 				ender = grok_hex(p + 1, &numlen, &flags, NULL);
 				if (ender > 0xff)
@@ -3053,7 +3054,7 @@ tryagain:
 			    }
 			}
 			else {
-                            I32 flags = 0;
+                            I32 flags = PERL_SCAN_DISALLOW_PREFIX;
 			    numlen = 2;
 			    ender = grok_hex(p, &numlen, &flags, NULL);
 			    p += numlen;
@@ -3084,7 +3085,7 @@ tryagain:
 			/* FALL THROUGH */
 		    default:
 			if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p))
-			    vWARN2(p +1, "Unrecognized escape \\%c passed through", *p);
+			    vWARN2(p + 1, "Unrecognized escape \\%c passed through", UCHARAT(p));
 			goto normal_default;
 		    }
 		    break;
@@ -3422,20 +3423,35 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
 		if (*RExC_parse == '{') {
 		    e = strchr(RExC_parse++, '}');
                     if (!e)
-                        vFAIL("Missing right brace on \\p{}");
+                        vFAIL2("Missing right brace on \\%c{}", value);
+		    while (isSPACE(UCHARAT(RExC_parse)))
+		        RExC_parse++;
+                    if (e == RExC_parse)
+                        vFAIL2("Empty \\%c{}", value);
 		    n = e - RExC_parse;
+		    while (isSPACE(UCHARAT(RExC_parse + n - 1)))
+		        n--;
 		}
 		else {
 		    e = RExC_parse;
 		    n = 1;
 		}
 		if (!SIZE_ONLY) {
+		    if (UCHARAT(RExC_parse) == '^') {
+			 RExC_parse++;
+			 n--;
+			 value = value == 'p' ? 'P' : 'p'; /* toggle */
+			 while (isSPACE(UCHARAT(RExC_parse))) {
+			      RExC_parse++;
+			      n--;
+			 }
+		    }
 		    if (value == 'p')
-			Perl_sv_catpvf(aTHX_ listsv,
-				       "+utf8::%.*s\n", (int)n, RExC_parse);
+			 Perl_sv_catpvf(aTHX_ listsv,
+					"+utf8::%.*s\n", (int)n, RExC_parse);
 		    else
-			Perl_sv_catpvf(aTHX_ listsv,
-				       "!utf8::%.*s\n", (int)n, RExC_parse);
+			 Perl_sv_catpvf(aTHX_ listsv,
+					"!utf8::%.*s\n", (int)n, RExC_parse);
 		}
 		RExC_parse = e + 1;
 		ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
@@ -3449,7 +3465,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
 	    case 'a':	value = ASCII_TO_NATIVE('\007');break;
 	    case 'x':
 		if (*RExC_parse == '{') {
-                    I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
+                    I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
+                        | PERL_SCAN_DISALLOW_PREFIX;
 		    e = strchr(RExC_parse++, '}');
                     if (!e)
                         vFAIL("Missing right brace on \\x{}");
@@ -3459,7 +3476,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
 		    RExC_parse = e + 1;
 		}
 		else {
-                    I32 flags = 0;
+                    I32 flags = PERL_SCAN_DISALLOW_PREFIX;
 		    numlen = 2;
 		    value = grok_hex(RExC_parse, &numlen, &flags, NULL);
 		    RExC_parse += numlen;