Re: sh Configure?

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

diff --git a/regcomp.c b/regcomp.c
index 409d03d..6befee8 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -244,7 +244,7 @@ PMOP* pm;
        if (sawplus && (!sawopen || !regsawback))
            r->reganch |= ROPT_SKIP;    /* x+ must match 1st of run */
 
-       DEBUG_r(fprintf(stderr,"first %d next %d offset %d\n",
+       DEBUG_r(PerlIO_printf(Perl_debug_log, "first %d next %d offset %d\n",
           OP(first), OP(NEXTOPER(first)), first - scan));
        /*
        * If there's something expensive in the r.e., find the
@@ -499,7 +499,7 @@ I32 *flagp;
     }
 
     /* Check for proper termination. */
-    if (paren && *nextchar() != ')') {
+    if (paren && (regparse >= regxend || *nextchar() != ')')) {
        FAIL("unmatched () in regexp");
     } else if (!paren && regparse < regxend) {
        if (*regparse == ')') {
@@ -868,6 +868,15 @@ tryagain:
            goto defchar;
        }
        break;
+
+    case '#':
+       if (regflags & PMf_EXTENDED) {
+           while (regparse < regxend && *regparse != '\n') regparse++;
+           if (regparse < regxend)
+               goto tryagain;
+       }
+       /* FALL THROUGH */
+
     default: {
            register I32 len;
            register char ender;
@@ -965,6 +974,11 @@ 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++;
@@ -1159,16 +1173,16 @@ nextchar()
 {
     char* retval = regparse++;
 
-    if (regflags & PMf_EXTENDED) {
-       for (;;) {
-           if (isSPACE(*regparse)) {
+    for (;;) {
+       if (*regparse == '(' && regparse[1] == '?' &&
+               regparse[2] == '#') {
+           while (*regparse && *regparse != ')')
                regparse++;
-               continue;
-           }
-           else if (*regparse == '(' && regparse[1] == '?' &&
-                   regparse[2] == '#') {
-               while (*regparse && *regparse != ')')
-                   regparse++;
+           regparse++;
+           continue;
+       }
+       if (regflags & PMf_EXTENDED) {
+           if (isSPACE(*regparse)) {
                regparse++;
                continue;
            }
@@ -1178,10 +1192,9 @@ nextchar()
                regparse++;
                continue;
            }
-           break;
        }
+       return retval;
     }
-    return retval;
 }
 
 /*
@@ -1419,7 +1432,7 @@ register char *s;
 #ifdef DEBUGGING
 
 /*
- - regdump - dump a regexp onto stderr in vaguely comprehensible form
+ - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
  */
 void
 regdump(r)
@@ -1437,13 +1450,13 @@ regexp *r;
            s++;
 #endif
        op = OP(s);
-       fprintf(stderr,"%2d%s", s-r->program, regprop(s));      /* Where, what. */
+       PerlIO_printf(Perl_debug_log, "%2d%s", s-r->program, regprop(s));       /* Where, what. */
        next = regnext(s);
        s += regarglen[(U8)op];
        if (next == NULL)               /* Next ptr. */
-           fprintf(stderr,"(0)");
+           PerlIO_printf(Perl_debug_log, "(0)");
        else 
-           fprintf(stderr,"(%d)", (s-r->program)+(next-s));
+           PerlIO_printf(Perl_debug_log, "(%d)", (s-r->program)+(next-s));
        s += 3;
        if (op == ANYOF) {
            s += 32;
@@ -1451,34 +1464,34 @@ regexp *r;
        if (op == EXACTLY) {
            /* Literal string, where present. */
            s++;
-           (void)putc(' ', stderr);
-           (void)putc('<', stderr);
+           (void)PerlIO_putc(Perl_debug_log, ' ');
+           (void)PerlIO_putc(Perl_debug_log, '<');
            while (*s != '\0') {
-               (void)putc(*s, stderr);
+               (void)PerlIO_putc(Perl_debug_log,*s);
                s++;
            }
-           (void)putc('>', stderr);
+           (void)PerlIO_putc(Perl_debug_log, '>');
            s++;
        }
-       (void)putc('\n', stderr);
+       (void)PerlIO_putc(Perl_debug_log, '\n');
     }
 
     /* Header fields of interest. */
     if (r->regstart)
-       fprintf(stderr,"start `%s' ", SvPVX(r->regstart));
+       PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
     if (r->regstclass)
-       fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
+       PerlIO_printf(Perl_debug_log, "stclass `%s' ", regprop(r->regstclass));
     if (r->reganch & ROPT_ANCH)
-       fprintf(stderr,"anchored ");
+       PerlIO_printf(Perl_debug_log, "anchored ");
     if (r->reganch & ROPT_SKIP)
-       fprintf(stderr,"plus ");
+       PerlIO_printf(Perl_debug_log, "plus ");
     if (r->reganch & ROPT_IMPLICIT)
-       fprintf(stderr,"implicit ");
+       PerlIO_printf(Perl_debug_log, "implicit ");
     if (r->regmust != NULL)
-       fprintf(stderr,"must have \"%s\" back %ld ", SvPVX(r->regmust),
+       PerlIO_printf(Perl_debug_log, "must have \"%s\" back %ld ", SvPVX(r->regmust),
         (long) r->regback);
-    fprintf(stderr, "minlen %ld ", (long) r->minlen);
-    fprintf(stderr,"\n");
+    PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
+    PerlIO_printf(Perl_debug_log, "\n");
 }
 
 /*