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
}
/* Check for proper termination. */
- if (paren && *nextchar() != ')') {
+ if (paren && (regparse >= regxend || *nextchar() != ')')) {
FAIL("unmatched () in regexp");
} else if (!paren && regparse < regxend) {
if (*regparse == ')') {
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;
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++;
{
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;
}
regparse++;
continue;
}
- break;
}
+ return retval;
}
- return retval;
}
/*
#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)
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;
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");
}
/*