Re: Bug in Regular Expressions when using colon as delimiter

[perl5.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index 5dad7d7..3e30253 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -467,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);
@@ -903,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++;
@@ -1523,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... */
@@ -1532,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. */
@@ -1561,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)
@@ -1585,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";
@@ -1655,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:
@@ -1731,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 */