From: Gurusamy Sarathy <gsar@cpan.org>
Date: Thu, 27 Apr 2000 18:29:05 +0000 (+0000)
Subject: fix for failure to match $foo =~ /(?i)/ (from Ilya Zakharevich)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf93d4cc8827842d1e2d40eecc0cc5927a17f3cd;p=p5sagit%2Fp5-mst-13.2.git

fix for failure to match $foo =~ /(?i)/ (from Ilya Zakharevich)

p4raw-id: //depot/perl@5973
---

diff --git a/regcomp.c b/regcomp.c
index c0425b7..7af090e 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -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);
diff --git a/regexec.c b/regexec.c
index 8f5278c..cd3df47 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1434,9 +1434,14 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 	/* 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)
@@ -1448,6 +1453,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 	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)
@@ -1456,6 +1462,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 		s++;
 	    }
 	}
+	DEBUG_r(did_match ||
+		PerlIO_printf(Perl_debug_log,
+			      "Did not find anchored character...\n"));
     }
     /*SUPPRESS 560*/
     else if (prog->anchored_substr != Nullsv
@@ -1471,6 +1480,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 			  -(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);
@@ -1489,6 +1501,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 		 : (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);
@@ -1514,6 +1527,14 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 		}
 	    }
 	}
+	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)) {
@@ -1522,6 +1543,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 	    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;
@@ -1554,7 +1576,12 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 			last = strend;	/* matching `$' */
 		}
 	    }
-	    if (last == NULL) goto phooey; /* Should not happen! */
+	    if (last == NULL) {
+		DEBUG_r(PerlIO_printf(Perl_debug_log,
+				      "%sCan'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))
@@ -1616,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;
diff --git a/t/op/re_tests b/t/op/re_tests
index d506e6e..189077c 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -750,3 +750,4 @@ tt+$	xxxtt	y	-	-
 ^([a-z]:)	C:/	n	-	-
 '^\S\s+aa$'m	\nx aa	y	-	-
 (^|a)b	ab	y	-	-
+(?i)		y	-	-