Front page | perl.perl5.porters |
Postings from April 2000
Re: [ID 20000331.027] [PATCH] (?i) doesn't work properly with otherwise
Thread Previous
|
Thread Next
From:
Ilya Zakharevich
Date:
April 5, 2000 16:53
Subject:
Re: [ID 20000331.027] [PATCH] (?i) doesn't work properly with otherwise
Message ID:
20000405195316.A26881@monk.mps.ohio-state.edu
On Sat, Apr 01, 2000 at 02:10:21PM -0500, ilya wrote:
> Gurusamy Sarathy writes:
> > The following program prints "ok" with 5.005,
> > but not with 5.6.
> >
> > print "ok\n" if $foo =~ /(?i)/;
--- ./t/op/re_tests~ Thu Jan 6 23:16:23 2000
+++ ./t/op/re_tests Wed Apr 5 19:05:37 2000
@@ -750,3 +750,4 @@ tt+$ xxxtt y - -
^([a-z]:) C:/ n - -
'^\S\s+aa$'m \nx aa y - -
(^|a)b ab y - -
+(?i) y - -
--- ./regcomp.c~ Tue Mar 14 17:19:44 2000
+++ ./regcomp.c Wed Apr 5 19:31:04 2000
@@ -2296,8 +2296,14 @@ tryagain:
nextchar();
ret = reg(1, &flags);
if (ret == NULL) {
- if (flags & TRYAGAIN)
+ if (flags & TRYAGAIN) {
+ if (PL_regcomp_parse == PL_regxend) {
+ /* Make parent create an empty node if needed. */
+ *flagp |= TRYAGAIN;
+ return(NULL);
+ }
goto tryagain;
+ }
return(NULL);
}
*flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
--- ./regexec.c~ Sun Mar 5 03:53:08 2000
+++ ./regexec.c Wed Apr 5 19:49:43 2000
@@ -1432,9 +1434,14 @@ Perl_regexec_flags(pTHX_ register regexp
/* we have /x+whatever/ */
/* it must be a one character string (XXXX Except UTF?) */
char ch = SvPVX(prog->anchored_substr)[0];
+#ifdef DEBUGGING
+ int did_match = 0;
+#endif
+
if (UTF) {
while (s < strend) {
if (*s == ch) {
+ DEBUG_r( did_match = 1 );
if (regtry(prog, s)) goto got_it;
s += UTF8SKIP(s);
while (s < strend && *s == ch)
@@ -1446,6 +1453,7 @@ Perl_regexec_flags(pTHX_ register regexp
else {
while (s < strend) {
if (*s == ch) {
+ DEBUG_r( did_match = 1 );
if (regtry(prog, s)) goto got_it;
s++;
while (s < strend && *s == ch)
@@ -1454,6 +1462,9 @@ Perl_regexec_flags(pTHX_ register regexp
s++;
}
}
+ DEBUG_r(did_match ||
+ PerlIO_printf(Perl_debug_log,
+ "Did not find anchored character...\n"));
}
/*SUPPRESS 560*/
else if (prog->anchored_substr != Nullsv
@@ -1469,6 +1480,9 @@ Perl_regexec_flags(pTHX_ register regexp
-(I32)(CHR_SVLEN(must)
- (SvTAIL(must) != 0) + back_min));
char *last1; /* Last position checked before */
+#ifdef DEBUGGING
+ int did_match = 0;
+#endif
if (s > PL_bostr)
last1 = HOPc(s, -1);
@@ -1487,6 +1501,7 @@ Perl_regexec_flags(pTHX_ register regexp
: (s = fbm_instr((unsigned char*)HOP(s, back_min),
(unsigned char*)strend, must,
PL_multiline ? FBMrf_MULTILINE : 0))) ) {
+ DEBUG_r( did_match = 1 );
if (HOPc(s, -back_max) > last1) {
last1 = HOPc(s, -back_min);
s = HOPc(s, -back_max);
@@ -1512,6 +1527,14 @@ Perl_regexec_flags(pTHX_ register regexp
}
}
}
+ DEBUG_r(did_match ||
+ PerlIO_printf(Perl_debug_log, "Did not find %s substr `%s%.*s%s'%s...\n",
+ ((must == prog->anchored_substr)
+ ? "anchored" : "floating"),
+ PL_colors[0],
+ (int)(SvCUR(must) - (SvTAIL(must)!=0)),
+ SvPVX(must),
+ PL_colors[1], (SvTAIL(must) ? "$" : "")));
goto phooey;
}
else if ((c = prog->regstclass)) {
@@ -1520,6 +1543,7 @@ Perl_regexec_flags(pTHX_ register regexp
strend = HOPc(strend, -(minlen - 1));
if (find_byclass(prog, c, s, strend, startpos, 0))
goto got_it;
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
}
else {
dontbother = 0;
@@ -1552,7 +1576,12 @@ Perl_regexec_flags(pTHX_ register regexp
last = strend; /* matching `$' */
}
}
- if (last == NULL) goto phooey; /* Should not happen! */
+ if (last == NULL) {
+ DEBUG_r(PerlIO_printf(Perl_debug_log,
+ "%sCann't trim the tail, match fails (should not happen)%s\n",
+ PL_colors[4],PL_colors[5]));
+ goto phooey; /* Should not happen! */
+ }
dontbother = strend - last + prog->float_min_offset;
}
if (minlen && (dontbother < minlen))
@@ -1614,6 +1643,8 @@ got_it:
return 1;
phooey:
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
+ PL_colors[4],PL_colors[5]));
if (PL_reg_eval_set)
restore_pos(aTHXo_ 0);
return 0;
Thread Previous
|
Thread Next