integrate cfgperl contents into mainline

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

diff --git a/regcomp.c b/regcomp.c
index 9768d18..89b3e53 100644 (file)
--- 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;