From: Yves Orton <demerphq@gmail.com>
Date: Wed, 4 Oct 2006 19:08:47 +0000 (+0200)
Subject: Re: [perl #8835] fairly large regex optimization bug with 5.7.3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=eaf3ca90bc6ae9ae7e97dcea569c7cee82be7d00;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #8835] fairly large regex optimization bug with 5.7.3
Message-ID: <9b18b3110610041008v2bd63d14g9294f93804122dec@mail.gmail.com>

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

diff --git a/regcomp.c b/regcomp.c
index 39a8469..4895ea4 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -3895,7 +3895,7 @@ reStudy:
 
     /* testing for BRANCH here tells us whether there is "must appear"
        data in the pattern. If there is then we can use it for optimisations */
-    if (OP(scan) != BRANCH) {	/* Only one top-level choice. */
+    if (!(RExC_seen & REG_TOP_LEVEL_BRANCHES)) { /*  Only one top-level choice. */
 	I32 fake;
 	STRLEN longest_float_length, longest_fixed_length;
 	struct regnode_charclass_class ch_class; /* pointed to by data */
@@ -4747,9 +4747,12 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
 	    ender = reg_node(pRExC_state, END);
 	    break;
 	}
-        REGTAIL_STUDY(pRExC_state, lastbr, ender);
+        REGTAIL(pRExC_state, lastbr, ender);
 
 	if (have_branch && !SIZE_ONLY) {
+	    if (depth==1)
+	        RExC_seen |= REG_TOP_LEVEL_BRANCHES;
+
 	    /* Hook the tails of the branches to the closing node. */
 	    for (br = ret; br; br = regnext(br)) {
 		const U8 op = PL_regkind[OP(br)];
@@ -7147,8 +7150,11 @@ S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 de
             SV * const mysv=sv_newmortal();
             DEBUG_PARSE_MSG((scan==p ? "tail" : ""));
             regprop(RExC_rx, mysv, scan);
-            PerlIO_printf(Perl_debug_log, "~ %s (%d)\n",
-                SvPV_nolen_const(mysv), REG_NODE_NUM(scan));
+            PerlIO_printf(Perl_debug_log, "~ %s (%d) %s %s\n",
+                SvPV_nolen_const(mysv), REG_NODE_NUM(scan),
+                    (temp == NULL ? "->" : ""),
+                    (temp == NULL ? reg_name[OP(val)] : "")
+            );
         });
         if (temp == NULL)
             break;
@@ -7225,10 +7231,10 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,
             SV * const mysv=sv_newmortal();
             DEBUG_PARSE_MSG((scan==p ? "tsdy" : ""));
             regprop(RExC_rx, mysv, scan);
-            PerlIO_printf(Perl_debug_log, "~ %s (%s) (%d)\n",
+            PerlIO_printf(Perl_debug_log, "~ %s (%d) -> %s\n",
                 SvPV_nolen_const(mysv),
-                reg_name[exact],
-                REG_NODE_NUM(scan));
+                REG_NODE_NUM(scan),
+                reg_name[exact]);
         });
 	if (temp == NULL)
 	    break;
diff --git a/regcomp.h b/regcomp.h
index 183420f..166be14 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -344,6 +344,7 @@ struct regnode_charclass_class {	/* has [[:blah:]] classes */
 #define REG_SEEN_CANY		0x00000010
 #define REG_SEEN_SANY		REG_SEEN_CANY /* src bckwrd cmpt */
 #define REG_SEEN_RECURSE        0x00000020
+#define REG_TOP_LEVEL_BRANCHES  0x00000040
 
 START_EXTERN_C