X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regexec.c;h=65a3b90e74db07078119d6f4b168be9cf5b53bf3;hb=54e82ce5cfd72fcdc60806373e0c4d6890b68a3c;hp=d55c5beee4c9c7f4eef16e4f1fb775a8e452c41b;hpb=30944b6df13d14ca352a3fdf86275e7fe6eb44b5;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/regexec.c b/regexec.c
index d55c5be..65a3b90 100644
--- a/regexec.c
+++ b/regexec.c
@@ -739,19 +739,23 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     /* If there is a "must appear" string, look for it. */
     s = startpos;
 
-    if (prog->reganch & ROPT_GPOS_SEEN) {
+    if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
 	MAGIC *mg;
 
-	if (!(flags & REXEC_IGNOREPOS) && sv && SvTYPE(sv) >= SVt_PVMG
-	    && SvMAGIC(sv) && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0)
-	    PL_reg_ganch = strbeg + mg->mg_len;
-	else
+	if (flags & REXEC_IGNOREPOS)	/* Means: check only at start */
 	    PL_reg_ganch = startpos;
-	if (prog->reganch & ROPT_ANCH_GPOS) {
-	    if (s > PL_reg_ganch)
-		goto phooey;
-	    s = PL_reg_ganch;
+	else if (sv && SvTYPE(sv) >= SVt_PVMG
+		  && SvMAGIC(sv)
+		  && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) {
+	    PL_reg_ganch = strbeg + mg->mg_len;	/* Defined pos() */
+	    if (prog->reganch & ROPT_ANCH_GPOS) {
+		if (s > PL_reg_ganch)
+		    goto phooey;
+		s = PL_reg_ganch;
+	    }
 	}
+	else				/* pos() not defined */
+	    PL_reg_ganch = strbeg;
     }
 
     if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {
@@ -1505,7 +1509,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
 	    }
 	    PL_reg_magic    = mg;
 	    PL_reg_oldpos   = mg->mg_len;
-	    SAVEDESTRUCTOR(restore_pos, 0);
+	    SAVEDESTRUCTOR_X(restore_pos, 0);
         }
 	if (!PL_reg_curpm)
 	    New(22,PL_reg_curpm, 1, PMOP);
@@ -1602,11 +1606,19 @@ S_regmatch(pTHX_ regnode *prog)
 #ifdef DEBUGGING
 #  define sayYES goto yes
 #  define sayNO goto no
+#  define sayYES_FINAL goto yes_final
+#  define sayYES_LOUD  goto yes_loud
+#  define sayNO_FINAL  goto no_final
+#  define sayNO_SILENT goto do_no
 #  define saySAME(x) if (x) goto yes; else goto no
 #  define REPORT_CODE_OFF 24
 #else
 #  define sayYES return 1
 #  define sayNO return 0
+#  define sayYES_FINAL return 1
+#  define sayYES_LOUD  return 1
+#  define sayNO_FINAL  return 0
+#  define sayNO_SILENT return 0
 #  define saySAME(x) return x
 #endif
 	DEBUG_r( {
@@ -2220,11 +2232,6 @@ S_regmatch(pTHX_ regnode *prog)
 			regcpblow(cp);
 			sayYES;
 		    }
-		    DEBUG_r(
-			PerlIO_printf(Perl_debug_log,
-				      "%*s  failed...\n",
-				      REPORT_CODE_OFF+PL_regindent*2, "")
-			);
 		    ReREFCNT_dec(re);
 		    REGCP_UNWIND;
 		    regcppop();
@@ -2411,11 +2418,6 @@ S_regmatch(pTHX_ regnode *prog)
 			);
 		    if (regmatch(cc->next))
 			sayYES;
-		    DEBUG_r(
-			PerlIO_printf(Perl_debug_log,
-				      "%*s  failed...\n",
-				      REPORT_CODE_OFF+PL_regindent*2, "")
-			);
 		    if (PL_regcc)
 			PL_regcc->cur = ln;
 		    PL_regcc = cc;
@@ -2431,11 +2433,6 @@ S_regmatch(pTHX_ regnode *prog)
 			sayYES;
 		    cc->cur = n - 1;
 		    cc->lastloc = lastloc;
-		    DEBUG_r(
-			PerlIO_printf(Perl_debug_log,
-				      "%*s  failed...\n",
-				      REPORT_CODE_OFF+PL_regindent*2, "")
-			);
 		    sayNO;
 		}
 
@@ -2478,7 +2475,7 @@ S_regmatch(pTHX_ regnode *prog)
 				      "%*s  already tried at this position...\n",
 				      REPORT_CODE_OFF+PL_regindent*2, "")
 			);
-			sayNO;
+			sayNO_SILENT;
 		    }
 		    PL_reg_poscache[o] |= (1<<b);
 		}
@@ -2528,11 +2525,6 @@ S_regmatch(pTHX_ regnode *prog)
 			regcpblow(cp);
 			sayYES;
 		    }
-		    DEBUG_r(
-			PerlIO_printf(Perl_debug_log,
-				      "%*s  failed...\n",
-				      REPORT_CODE_OFF+PL_regindent*2, "")
-			);
 		    REGCP_UNWIND;
 		    regcppop();
 		    cc->cur = n - 1;
@@ -2574,10 +2566,6 @@ S_regmatch(pTHX_ regnode *prog)
 		    ln = PL_regcc->cur;
 		if (regmatch(cc->next))
 		    sayYES;
-		DEBUG_r(
-		    PerlIO_printf(Perl_debug_log, "%*s  failed...\n",
-				  REPORT_CODE_OFF+PL_regindent*2, "")
-		    );
 		if (PL_regcc)
 		    PL_regcc->cur = ln;
 		PL_regcc = cc;
@@ -2972,14 +2960,22 @@ S_regmatch(pTHX_ regnode *prog)
 				  "%*s  continuation failed...\n",
 				  REPORT_CODE_OFF+PL_regindent*2, "")
 		    );
-		sayNO;
+		sayNO_SILENT;
 	    }
-	    if (locinput < PL_regtill)
-		sayNO;			/* Cannot match: too short. */
-	    /* Fall through */
+	    if (locinput < PL_regtill) {
+		DEBUG_r(PerlIO_printf(Perl_debug_log,
+				      "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
+				      PL_colors[4],
+				      (long)(locinput - PL_reg_starttry),
+				      (long)(PL_regtill - PL_reg_starttry),
+				      PL_colors[5]));
+		sayNO_FINAL;		/* Cannot match: too short. */
+	    }
+	    PL_reginput = locinput;	/* put where regtry can find it */
+	    sayYES_FINAL;		/* Success! */
 	case SUCCEED:
 	    PL_reginput = locinput;	/* put where regtry can find it */
-	    sayYES;			/* Success! */
+	    sayYES_LOUD;		/* Success! */
 	case SUSPEND:
 	    n = 1;
 	    PL_reginput = locinput;
@@ -3055,7 +3051,7 @@ S_regmatch(pTHX_ regnode *prog)
 		next = NULL;
 	    break;
 	default:
-	    PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
+	    PerlIO_printf(Perl_error_log, "%lx %d\n",
 			  (unsigned long)scan, OP(scan));
 	    Perl_croak(aTHX_ "regexp memory corruption");
 	}
@@ -3070,6 +3066,16 @@ S_regmatch(pTHX_ regnode *prog)
     /*NOTREACHED*/
     sayNO;
 
+yes_loud:
+    DEBUG_r(
+	PerlIO_printf(Perl_debug_log,
+		      "%*s  %scould match...%s\n",
+		      REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
+	);
+    goto yes;
+yes_final:
+    DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
+			  PL_colors[4],PL_colors[5]));
 yes:
 #ifdef DEBUGGING
     PL_regindent--;
@@ -3077,6 +3083,14 @@ yes:
     return 1;
 
 no:
+    DEBUG_r(
+	PerlIO_printf(Perl_debug_log,
+		      "%*s  %sfailed...%s\n",
+		      REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
+	);
+    goto do_no;
+no_final:
+do_no:
 #ifdef DEBUGGING
     PL_regindent--;
 #endif