Explain an apparent bug reported by

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

diff --git a/regcomp.c b/regcomp.c
index c170a47..4455730 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -259,7 +259,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 #define        FAIL(msg)                                                             \
     STMT_START {                                                             \
         char *ellipses = "";                                                 \
-        unsigned len = strlen(RExC_precomp);                                \
+        IV len = RExC_end - RExC_precomp;                                \
                                                                              \
        if (!SIZE_ONLY)                                                      \
            SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);                 \
@@ -281,7 +281,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 #define        FAIL2(pat,msg)                                                        \
     STMT_START {                                                             \
         char *ellipses = "";                                                 \
-        unsigned len = strlen(RExC_precomp);                                \
+        IV len = RExC_end - RExC_precomp;                                \
                                                                              \
        if (!SIZE_ONLY)                                                      \
            SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);                 \
@@ -301,7 +301,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  */
 #define        Simple_vFAIL(m)                                                      \
     STMT_START {                                                             \
-      unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
+      IV offset = RExC_parse - RExC_precomp; \
                                                                              \
       Perl_croak(aTHX_ "%s" REPORT_LOCATION,               \
                 m, (int)offset, RExC_precomp, RExC_precomp + offset);     \
@@ -322,7 +322,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  */
 #define        Simple_vFAIL2(m,a1)                                                  \
     STMT_START {                                                             \
-      unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
+      IV offset = RExC_parse - RExC_precomp; \
                                                                              \
       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1,       \
                  (int)offset, RExC_precomp, RExC_precomp + offset);       \
@@ -344,7 +344,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  */
 #define        Simple_vFAIL3(m, a1, a2)                                             \
     STMT_START {                                                             \
-      unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
+      IV offset = RExC_parse - RExC_precomp; \
                                                                              \
       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2,   \
                  (int)offset, RExC_precomp, RExC_precomp + offset);       \
@@ -365,7 +365,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  */
 #define        Simple_vFAIL4(m, a1, a2, a3)                                         \
     STMT_START {                                                             \
-      unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
+      IV offset = RExC_parse - RExC_precomp; \
                                                                              \
       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3,\
                  (int)offset, RExC_precomp, RExC_precomp + offset);       \
@@ -376,7 +376,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  */
 #define        Simple_vFAIL5(m, a1, a2, a3, a4)                                     \
     STMT_START {                                                             \
-      unsigned offset = strlen(RExC_precomp)-(RExC_end-RExC_parse); \
+      IV offset = RExC_parse - RExC_precomp; \
       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, a4,\
                  (int)offset, RExC_precomp, RExC_precomp + offset);       \
     } STMT_END
@@ -384,14 +384,14 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 
 #define        vWARN(loc,m)                                                         \
     STMT_START {                                                             \
-        unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));          \
+        IV offset = loc - RExC_precomp;          \
        Perl_warner(aTHX_ WARN_REGEXP, "%s" REPORT_LOCATION,\
                 m, (int)offset, RExC_precomp, RExC_precomp + offset);          \
     } STMT_END                                                               \
 
 #define        vWARNdep(loc,m)                                                         \
     STMT_START {                                                             \
-        unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));          \
+        IV offset = loc - RExC_precomp;          \
         int warn_cat = ckWARN(WARN_REGEXP) ? WARN_REGEXP : WARN_DEPRECATED;  \
        Perl_warner(aTHX_ warn_cat, "%s" REPORT_LOCATION,\
                 m, (int)offset, RExC_precomp, RExC_precomp + offset);          \
@@ -400,7 +400,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 
 #define        vWARN2(loc, m, a1)                                                   \
     STMT_START {                                                             \
-        unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));          \
+        IV offset = loc - RExC_precomp;          \
        Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
                  a1,                                                         \
                 (int)offset, RExC_precomp, RExC_precomp + offset);        \
@@ -408,7 +408,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 
 #define        vWARN3(loc, m, a1, a2)                                               \
     STMT_START {                                                             \
-      unsigned offset = strlen(RExC_precomp) - (RExC_end - (loc));        \
+      IV offset = loc - RExC_precomp;        \
        Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,                    \
                  a1, a2,                                                     \
                 (int)offset, RExC_precomp, RExC_precomp + offset);        \
@@ -416,7 +416,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 
 #define        vWARN4(loc, m, a1, a2, a3)                                           \
     STMT_START {                                                             \
-      unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));            \
+      IV offset = loc - RExC_precomp;            \
        Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
                  a1, a2, a3,                                                 \
                 (int)offset, RExC_precomp, RExC_precomp + offset);        \
@@ -425,7 +425,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 /* used for the parse_flags section for (?c) -- japhy */
 #define        vWARN5(loc, m, a1, a2, a3, a4)                                       \
   STMT_START {                                                   \
-      unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));   \
+      IV offset = loc - RExC_precomp;   \
         Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,      \
                  a1, a2, a3, a4,                                 \
                  (int)offset, RExC_precomp, RExC_precomp + offset);  \
@@ -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,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)
@@ -3049,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;
@@ -3445,7 +3450,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{}");
@@ -3455,7 +3461,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;