The exact error message is system-dependent.

[p5sagit/p5-mst-13.2.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index dfe3080..4b07fd2 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -967,6 +967,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
            regnode *oscan = scan;
            struct regnode_charclass_class this_class;
            struct regnode_charclass_class *oclass = NULL;
+           I32 next_is_eval = 0;
 
            switch (PL_regkind[(U8)OP(scan)]) {
            case WHILEM:                /* End of (?:...)* . */
@@ -1012,6 +1013,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                    scan->flags = ((lp <= U8_MAX) ? lp : U8_MAX);
                }
                scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
+               next_is_eval = (OP(scan) == EVAL);
              do_curly:
                if (flags & SCF_DO_SUBSTR) {
                    if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
@@ -1073,6 +1075,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                if (!scan)              /* It was not CURLYX, but CURLY. */
                    scan = next;
                if (ckWARN(WARN_REGEXP)
+                      /* ? quantifier ok, except for (?{ ... }) */
+                   && (next_is_eval || !(mincount == 0 && maxcount == 1))
                    && (minnext == 0) && (deltanext == 0)
                    && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
                    && maxcount <= REG_INFTY/3) /* Complement check for big count */
@@ -3035,8 +3039,9 @@ tryagain:
                                vFAIL("Missing right brace on \\x{}");
                            }
                            else {
-                               numlen = 1;     /* allow underscores */
-                               ender = (UV)scan_hex(p + 1, e - p - 1, &numlen);
+                                I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
+                                numlen = e - p - 1;
+                               ender = grok_hex(p + 1, &numlen, &flags, NULL);
                                if (ender > 0xff)
                                    RExC_utf8 = 1;
                                /* numlen is generous */
@@ -3048,8 +3053,9 @@ tryagain:
                            }
                        }
                        else {
-                           numlen = 0;         /* disallow underscores */
-                           ender = (UV)scan_hex(p, 2, &numlen);
+                            I32 flags = 0;
+                           numlen = 2;
+                           ender = grok_hex(p, &numlen, &flags, NULL);
                            p += numlen;
                        }
                        break;
@@ -3062,8 +3068,9 @@ tryagain:
                    case '5': case '6': case '7': case '8':case '9':
                        if (*p == '0' ||
                          (isDIGIT(p[1]) && atoi(p) >= RExC_npar) ) {
-                           numlen = 0;         /* disallow underscores */
-                           ender = (UV)scan_oct(p, 3, &numlen);
+                            I32 flags = 0;
+                           numlen = 3;
+                           ender = grok_oct(p, &numlen, &flags, NULL);
                            p += numlen;
                        }
                        else {
@@ -3442,18 +3449,19 @@ 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;
                    e = strchr(RExC_parse++, '}');
                     if (!e)
                         vFAIL("Missing right brace on \\x{}");
-                   numlen = 1;         /* allow underscores */
-                   value = (UV)scan_hex(RExC_parse,
-                                        e - RExC_parse,
-                                        &numlen);
+
+                   numlen = e - RExC_parse;
+                   value = grok_hex(RExC_parse, &numlen, &flags, NULL);
                    RExC_parse = e + 1;
                }
                else {
-                   numlen = 0;         /* disallow underscores */
-                   value = (UV)scan_hex(RExC_parse, 2, &numlen);
+                    I32 flags = 0;
+                   numlen = 2;
+                   value = grok_hex(RExC_parse, &numlen, &flags, NULL);
                    RExC_parse += numlen;
                }
                break;
@@ -3463,10 +3471,13 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
                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(--RExC_parse, 3, &numlen);
+            {
+                I32 flags = 0;
+               numlen = 3;
+               value = grok_oct(--RExC_parse, &numlen, &flags, NULL);
                RExC_parse += numlen;
                break;
+            }
            default:
                if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
                    vWARN2(RExC_parse,