develooper 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


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About