* blame Henry for some of the lack of readability.
*/
+/* The names of the functions have been changed from regcomp and
+ * regexec to pregcomp and pregexec in order to avoid conflicts
+ * with the POSIX routines of the same names.
+*/
+
/*SUPPRESS 112*/
/*
- * regcomp and regexec -- regsub and regerror are not used in perl
+ * pregcomp and pregexec -- regsub and regerror are not used in perl
*
* Copyright (c) 1986 by University of Toronto.
* Written by Henry Spencer. Not derived from licensed software.
#define TRYAGAIN 0x8 /* Weeded out a declaration. */
/*
- * Forward declarations for regcomp()'s friends.
+ * Forward declarations for pregcomp()'s friends.
*/
static char *reg _((I32, I32 *));
static char* nextchar _((void));
/*
- - regcomp - compile a regular expression into internal code
+ - pregcomp - compile a regular expression into internal code
*
* We can't allocate space until we know how big the compiled form will be,
* but we can't compile it (and thus know how big it is) until we've got a
* of the structure of the compiled regexp. [I'll say.]
*/
regexp *
-regcomp(exp,xend,pm)
+pregcomp(exp,xend,pm)
char* exp;
char* xend;
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
}
else /* single branch is ok */
scan = NEXTOPER(scan);
+ continue;
}
if (OP(scan) == UNLESSM) {
curback = -30000;
scan = regnext(scan);
+ continue;
}
if (OP(scan) == EXACTLY) {
char *t;
if (paren) {
if (*regparse == '?') {
regparse++;
- paren = *nextchar();
+ paren = *regparse++;
ret = NULL;
switch (paren) {
case ':':
while (*regparse && *regparse != ')')
regparse++;
if (*regparse != ')')
- croak("Sequence (?#... not terminated", *regparse);
+ croak("Sequence (?#... not terminated");
nextchar();
*flagp = TRYAGAIN;
return NULL;
}
/* 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) {
- while (isSPACE(*regparse))
+ for (;;) {
+ if (*regparse == '(' && regparse[1] == '?' &&
+ regparse[2] == '#') {
+ while (*regparse && *regparse != ')')
+ regparse++;
regparse++;
+ continue;
+ }
+ if (regflags & PMf_EXTENDED) {
+ if (isSPACE(*regparse)) {
+ regparse++;
+ continue;
+ }
+ else if (*regparse == '#') {
+ while (*regparse && *regparse != '\n')
+ regparse++;
+ regparse++;
+ continue;
+ }
+ }
+ 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");
}
/*
#endif /* DEBUGGING */
void
-regfree(r)
+pregfree(r)
struct regexp *r;
{
if (!r)
projects / p5sagit/p5-mst-13.2.git / blobdiff