X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regexec.c;h=7b9f1c4f673554b30e639551d6d5cbb1ee4e58d0;hb=b38b066d1cf1b115dd83bdf7e4355e8870134fb9;hp=bf99d49ae55676917c9a1a1f1b1e7de36320b82a;hpb=4d1ff10ffec86208b0da135b87c76b89e61c866e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/regexec.c b/regexec.c
index bf99d49..7b9f1c4 100644
--- a/regexec.c
+++ b/regexec.c
@@ -80,12 +80,6 @@
 #define PERL_IN_REGEXEC_C
 #include "perl.h"
 
-#ifdef PERL_IN_XSUB_RE
-#  if defined(PERL_CAPI) || defined(PERL_OBJECT)
-#    include "XSUB.h"
-#  endif
-#endif
-
 #include "regcomp.h"
 
 #define RF_tainted	1		/* tainted information used? */
@@ -107,17 +101,17 @@
  */
 
 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
-#define CHR_DIST(a,b) (PL_reg_sv_utf8 ? utf8_distance(a,b) : a - b)
+#define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
 
 #define reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
 #define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
-#define HOP(pos,off) (PL_reg_sv_utf8 ? reghop((U8*)pos, off) : (U8*)(pos + off))
-#define HOPMAYBE(pos,off) (PL_reg_sv_utf8 ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
+#define HOP(pos,off) (PL_reg_match_utf8 ? reghop((U8*)pos, off) : (U8*)(pos + off))
+#define HOPMAYBE(pos,off) (PL_reg_match_utf8 ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
 #define HOPc(pos,off) ((char*)HOP(pos,off))
 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
 
 #define HOPBACK(pos, off) (		\
-    (UTF && PL_reg_sv_utf8)		\
+    (UTF && PL_reg_match_utf8)		\
 	? reghopmaybe((U8*)pos, -off)	\
     : (pos - off >= PL_bostr)		\
 	? (U8*)(pos - off)		\
@@ -127,14 +121,20 @@
 
 #define reghop3_c(pos,off,lim) ((char*)reghop3((U8*)pos, off, (U8*)lim))
 #define reghopmaybe3_c(pos,off,lim) ((char*)reghopmaybe3((U8*)pos, off, (U8*)lim))
-#define HOP3(pos,off,lim) (PL_reg_sv_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
-#define HOPMAYBE3(pos,off,lim) (PL_reg_sv_utf8 ? reghopmaybe3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
+#define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
+#define HOPMAYBE3(pos,off,lim) (PL_reg_match_utf8 ? reghopmaybe3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 #define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim))
 
 #define LOAD_UTF8_CHARCLASS(a,b) STMT_START { if (!CAT2(PL_utf8_,a)) (void)CAT2(is_utf8_, a)((U8*)b); } STMT_END
 
-static void restore_pos(pTHXo_ void *arg);
+/* for use after a quantifier and before an EXACT-like node -- japhy */
+#define NEXT_IMPT(to_rn) STMT_START { \
+    while (OP(to_rn) == OPEN || OP(to_rn) == CLOSE || OP(to_rn) == EVAL) \
+	to_rn += NEXT_OFF(to_rn); \
+} STMT_END 
+
+static void restore_pos(pTHX_ void *arg);
 
 STATIC CHECKPOINT
 S_regcppush(pTHX_ I32 parenfloor)
@@ -878,7 +878,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
 	unsigned int c2;
 	char *e;
 	register I32 tmp = 1;	/* Scratch variable? */
-	register bool do_utf8 = PL_reg_sv_utf8;
+	register bool do_utf8 = PL_reg_match_utf8;
 
 	/* We know what class it must start with. */
 	switch (OP(c)) {
@@ -1775,7 +1775,7 @@ got_it:
 	    sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
 						  restored, the value remains
 						  the same. */
-	restore_pos(aTHXo_ 0);
+	restore_pos(aTHX_ 0);
     }
 
     /* make sure $`, $&, $', and $digit will work later */
@@ -1804,7 +1804,7 @@ 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);
+	restore_pos(aTHX_ 0);
     return 0;
 }
 
@@ -2009,7 +2009,7 @@ S_regmatch(pTHX_ regnode *prog)
 #if 0
     I32 firstcp = PL_savestack_ix;
 #endif
-    register bool do_utf8 = PL_reg_sv_utf8;
+    register bool do_utf8 = PL_reg_match_utf8;
 
 #ifdef DEBUGGING
     PL_regindent++;
@@ -3043,14 +3043,29 @@ S_regmatch(pTHX_ regnode *prog)
 		if (ln && l == 0)
 		    n = ln;	/* don't backtrack */
 		locinput = PL_reginput;
-		if (PL_regkind[(U8)OP(next)] == EXACT) {
-		    c1 = (U8)*STRING(next);
-		    if (OP(next) == EXACTF)
-			c2 = PL_fold[c1];
-		    else if (OP(next) == EXACTFL)
-			c2 = PL_fold_locale[c1];
-		    else
-			c2 = c1;
+		if (
+		    PL_regkind[(U8)OP(next)] == EXACT ||
+		    OP(next) == OPEN ||
+		    OP(next) == CLOSE ||
+		    OP(next) == EVAL
+		) {
+		    regnode *text_node = next;
+
+		    if (PL_regkind[(U8)OP(next)] != EXACT)
+			NEXT_IMPT(text_node);
+
+		    if (PL_regkind[(U8)OP(text_node)] != EXACT) {
+			c1 = c2 = -1000;
+		    }
+		    else {
+			c1 = (U8)*STRING(text_node);
+			if (OP(next) == EXACTF)
+			    c2 = PL_fold[c1];
+			else if (OP(text_node) == EXACTFL)
+			    c2 = PL_fold_locale[c1];
+			else
+			    c2 = c1;
+		    }
 		}
 		else
 		    c1 = c2 = -1000;
@@ -3102,14 +3117,29 @@ S_regmatch(pTHX_ regnode *prog)
 				  (IV) n, (IV)l)
 		    );
 		if (n >= ln) {
-		    if (PL_regkind[(U8)OP(next)] == EXACT) {
-			c1 = (U8)*STRING(next);
-			if (OP(next) == EXACTF)
-			    c2 = PL_fold[c1];
-			else if (OP(next) == EXACTFL)
-			    c2 = PL_fold_locale[c1];
-			else
-			    c2 = c1;
+		    if (
+			PL_regkind[(U8)OP(next)] == EXACT ||
+			OP(next) == OPEN ||
+			OP(next) == CLOSE ||
+			OP(next) == EVAL
+		    ) {
+			regnode *text_node = next;
+
+			if (PL_regkind[(U8)OP(next)] != EXACT)
+			    NEXT_IMPT(text_node);
+
+			if (PL_regkind[(U8)OP(text_node)] != EXACT) {
+			    c1 = c2 = -1000;
+			}
+			else {
+			    c1 = (U8)*STRING(text_node);
+			    if (OP(text_node) == EXACTF)
+				c2 = PL_fold[c1];
+			    else if (OP(text_node) == EXACTFL)
+				c2 = PL_fold_locale[c1];
+			    else
+				c2 = c1;
+			}
 		    }
 		    else
 			c1 = c2 = -1000;
@@ -3179,22 +3209,46 @@ S_regmatch(pTHX_ regnode *prog)
 	    * Lookahead to avoid useless match attempts
 	    * when we know what character comes next.
 	    */
-	    if (PL_regkind[(U8)OP(next)] == EXACT) {
-		U8 *s = (U8*)STRING(next);
-		if (!UTF) {
-		    c2 = c1 = *s;
-		    if (OP(next) == EXACTF)
-			c2 = PL_fold[c1];
-		    else if (OP(next) == EXACTFL)
-			c2 = PL_fold_locale[c1];
-		}
-		else { /* UTF */
-		    if (OP(next) == EXACTF) {
-			c1 = to_utf8_lower(s);
-			c2 = to_utf8_upper(s);
+
+	    /*
+	    * Used to only do .*x and .*?x, but now it allows
+	    * for )'s, ('s and (?{ ... })'s to be in the way
+	    * of the quantifier and the EXACT-like node.  -- japhy
+	    */
+
+	    if (
+		PL_regkind[(U8)OP(next)] == EXACT ||
+		OP(next) == OPEN ||
+		OP(next) == CLOSE ||
+		OP(next) == EVAL
+	    ) {
+		U8 *s;
+		regnode *text_node = next;
+
+		if (PL_regkind[(U8)OP(next)] != EXACT)
+		    NEXT_IMPT(text_node);
+
+		if (PL_regkind[(U8)OP(text_node)] != EXACT) {
+		    c1 = c2 = -1000;
+		}
+		else {
+		    s = (U8*)STRING(text_node);
+
+		    if (!UTF) {
+			c2 = c1 = *s;
+			if (OP(text_node) == EXACTF)
+			    c2 = PL_fold[c1];
+			else if (OP(text_node) == EXACTFL)
+			    c2 = PL_fold_locale[c1];
 		    }
-		    else {
-			c2 = c1 = utf8_to_uvchr(s, NULL);
+		    else { /* UTF */
+			if (OP(text_node) == EXACTF) {
+			    c1 = to_utf8_lower(s);
+			    c2 = to_utf8_upper(s);
+			}
+			else {
+			    c2 = c1 = utf8_to_uvchr(s, NULL);
+			}
 		    }
 		}
 	    }
@@ -3590,7 +3644,7 @@ S_regrepeat(pTHX_ regnode *p, I32 max)
     register I32 c;
     register char *loceol = PL_regeol;
     register I32 hardcount = 0;
-    register bool do_utf8 = PL_reg_sv_utf8;
+    register bool do_utf8 = PL_reg_match_utf8;
 
     scan = PL_reginput;
     if (max != REG_INFTY && max < loceol - scan)
@@ -3829,7 +3883,7 @@ S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
 	return 0;
 
     start = PL_reginput;
-    if (PL_reg_sv_utf8) {
+    if (PL_reg_match_utf8) {
 	while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
 	    if (!count++) {
 		l = 0;
@@ -4065,12 +4119,8 @@ S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
     return s;
 }
 
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
 static void
-restore_pos(pTHXo_ void *arg)
+restore_pos(pTHX_ void *arg)
 {
     if (PL_reg_eval_set) {
 	if (PL_reg_oldsaved) {