This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: Bug in Regular Expressions when using colon as delimiter
[perl5.git] / regcomp.c
index 0621c39..3e30253 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -109,6 +109,7 @@ static void reginsert _((char, char *));
 static void regoptail _((char *, char *));
 static void regset _((char *, I32));
 static void regtail _((char *, char *));
+static char* regwhite _((char *, char *));
 static char* nextchar _((void));
 
 /*
@@ -466,9 +467,12 @@ I32 *flagp;
                nextchar();
                *flagp = TRYAGAIN;
                return NULL;
+            case 0:
+                croak("Sequence (? incomplete");
+                break;
            default:
                --regparse;
-               while (*regparse && strchr("iogmsx", *regparse))
+               while (*regparse && strchr("iogcmsx", *regparse))
                    pmflag(&regflags, *regparse++);
                if (*regparse != ')')
                    croak("Sequence (?%c...) not recognized", *regparse);
@@ -696,6 +700,10 @@ I32 *flagp;
        *flagp = flags;
        return(ret);
     }
+
+    if (!(flags&HASWIDTH) && op != '?')
+      FAIL("regexp *+ operand could be empty");
+
     nextchar();
 
     *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
@@ -898,7 +906,9 @@ tryagain:
                    goto defchar;
                else {
                    regsawback = 1;
-                   ret = reganode(REF, num);
+                   ret = reganode((regflags & PMf_FOLD)
+                                  ? ((regflags & PMf_LOCALE) ? REFFL : REFF)
+                                  : REF, num);
                    *flagp |= HASWIDTH;
                    while (isDIGIT(*regparse))
                        regparse++;
@@ -943,6 +953,9 @@ tryagain:
              len++)
            {
                oldp = p;
+
+               if (regflags & PMf_EXTENDED)
+                   p = regwhite(p, regxend);
                switch (*p) {
                case '^':
                case '$':
@@ -1021,22 +1034,12 @@ tryagain:
                        break;
                    }
                    break;
-               case '#':
-                   if (regflags & PMf_EXTENDED) {
-                       while (p < regxend && *p != '\n') p++;
-                   }
-                   /* FALL THROUGH */
-               case ' ': case '\t': case '\n': case '\r': case '\f': case '\v':
-                   if (regflags & PMf_EXTENDED) {
-                       p++;
-                       len--;
-                       continue;
-                   }
-                   /* FALL THROUGH */
                default:
                    ender = *p++;
                    break;
                }
+               if (regflags & PMf_EXTENDED)
+                   p = regwhite(p, regxend);
                if (ISMULT2(p)) { /* Back off on ?+*. */
                    if (len)
                        p = oldp;
@@ -1067,6 +1070,25 @@ tryagain:
     return(ret);
 }
 
+static char *
+regwhite(p, e)
+char *p;
+char *e;
+{
+    while (p < e) {
+       if (isSPACE(*p))
+           ++p;
+       else if (*p == '#') {
+           do {
+               p++;
+           } while (p < e && *p != '\n');
+       }
+       else
+           break;
+    }
+    return p;
+}
+
 static void
 regset(opnd, c)
 char *opnd;
@@ -1506,7 +1528,7 @@ regexp *r;
     register char *s;
     register char op = EXACT;  /* Arbitrary non-END op. */
     register char *next;
-
+    SV *sv = sv_newmortal();
 
     s = r->program + 1;
     while (op != END) {        /* While that wasn't END last time... */
@@ -1515,7 +1537,9 @@ regexp *r;
            s++;
 #endif
        op = OP(s);
-       PerlIO_printf(Perl_debug_log, "%2d%s", s-r->program, regprop(s));       /* Where, what. */
+       /* where, what */
+       regprop(sv, s);
+       PerlIO_printf(Perl_debug_log, "%2d%s", s - r->program, SvPVX(sv));
        next = regnext(s);
        s += regarglen[(U8)op];
        if (next == NULL)               /* Next ptr. */
@@ -1544,8 +1568,10 @@ regexp *r;
     /* Header fields of interest. */
     if (r->regstart)
        PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
-    if (r->regstclass)
-       PerlIO_printf(Perl_debug_log, "stclass `%s' ", regprop(r->regstclass));
+    if (r->regstclass) {
+       regprop(sv, r->regstclass);
+       PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
+    }
     if (r->reganch & ROPT_ANCH) {
        PerlIO_printf(Perl_debug_log, "anchored");
        if (r->reganch & ROPT_ANCH_BOL)
@@ -1568,14 +1594,14 @@ regexp *r;
 /*
 - regprop - printable representation of opcode
 */
-char *
-regprop(op)
+void
+regprop(sv, op)
+SV *sv;
 char *op;
 {
     register char *p = 0;
 
-    (void) strcpy(buf, ":");
-
+    sv_setpv(sv, ":");
     switch (OP(op)) {
     case BOL:
        p = "BOL";
@@ -1638,23 +1664,25 @@ char *op;
        p = "NBOUNDL";
        break;
     case CURLY:
-       (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op));
-       p = NULL;
+       sv_catpvf(sv, "CURLY {%d,%d}", ARG1(op), ARG2(op));
        break;
     case CURLYX:
-       (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op));
-       p = NULL;
+       sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(op), ARG2(op));
        break;
     case REF:
-       (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
-       p = NULL;
+       sv_catpvf(sv, "REF%d", ARG1(op));
+       break;
+    case REFF:
+       sv_catpvf(sv, "REFF%d", ARG1(op));
+       break;
+    case REFFL:
+       sv_catpvf(sv, "REFFL%d", ARG1(op));
        break;
     case OPEN:
-       (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
-       p = NULL;
+       sv_catpvf(sv, "OPEN%d", ARG1(op));
        break;
     case CLOSE:
-       (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
+       sv_catpvf(sv, "CLOSE%d", ARG1(op));
        p = NULL;
        break;
     case STAR:
@@ -1714,9 +1742,8 @@ char *op;
     default:
        FAIL("corrupted regexp opcode");
     }
-    if (p != NULL)
-       (void) strcat(buf, p);
-    return(buf);
+    if (p)
+       sv_catpv(sv, p);
 }
 #endif /* DEBUGGING */