regcomp_study.c - disable CURLYX optimizations when EVAL has been seen anywhere

Historically we disabled CURLYX optimizations when they
*contained* an EVAL, on the assumption that the optimization might
affect how many times, etc, the eval was called. However, this is
also true for CURLYX with evals *afterwards*. If the CURLYN or CURLYM
optimization can prune off the search space, then an eval afterwards
will be affected. An when you take into account GOSUB, it means that
an eval in front might be affected by an optimization after it.

So for now we disable CURLYN and CURLYM in any pattern with an EVAL.

Author: demerphq

regcomp_debug.c

@@ -83,8 +83,12 @@ Perl_debug_studydata(pTHX_ const char *where, scan_data_t *data,
     DECLARE_AND_GET_RE_DEBUG_FLAGS;
 
     DEBUG_OPTIMISE_MORE_r({
-        if (!data)
+        if (!data) {
+            Perl_re_indentf(aTHX_  "%s: NO DATA",
+                depth,
+                where);
             return;
+        }
         Perl_re_indentf(aTHX_  "%s: M/S/D: %" IVdf "/%" IVdf "/%" IVdf " Pos:%" IVdf "/%" IVdf " Flags: 0x%" UVXf,
             depth,
             where,

regcomp_study.c

@@ -2688,23 +2688,26 @@ Perl_study_chunk(pTHX_
                         stopmin = min;
                     DEBUG_STUDYDATA("after-whilem accept", data, depth, is_inf, min, stopmin, delta);
                 }
+                DEBUG_STUDYDATA("PRE CURLYX_TO_CURLYN", data, depth, is_inf, min, stopmin, delta);
                 /* Try powerful optimization CURLYX => CURLYN. */
                 if ( RE_OPTIMIZE_CURLYX_TO_CURLYN
                      && OP(oscan) == CURLYX
                      && data
-                     && data->flags & SF_IN_PAR
-                     && !(data->flags & SF_HAS_EVAL)
+                     && !pRExC_state->code_blocks /* XXX: for now disable whenever eval
+                                                     is seen anywhere. We need a better
+                                                     way. */
+                     && ( ( data->flags & (SF_IN_PAR|SF_HAS_EVAL) ) == SF_IN_PAR )
                      && !deltanext
                      && minnext == 1
                      && mutate_ok
                 ) {
+                    DEBUG_STUDYDATA("CURLYX_TO_CURLYN", data, depth, is_inf, min, stopmin, delta);
                     /* Try to optimize to CURLYN.  */
                     regnode *nxt = REGNODE_AFTER_type(oscan, tregnode_CURLYX);
                     regnode * const nxt1 = nxt;
 #ifdef DEBUGGING
                     regnode *nxt2;
 #endif
-
                     /* Skip open. */
                     nxt = regnext(nxt);
                     if (!REGNODE_SIMPLE(OP(nxt))
@@ -2741,10 +2744,15 @@ Perl_study_chunk(pTHX_
                 }
               nogo:
 
+                DEBUG_STUDYDATA("PRE CURLYX_TO_CURLYM", data, depth, is_inf, min, stopmin, delta);
+
                 /* Try optimization CURLYX => CURLYM. */
                 if ( RE_OPTIMIZE_CURLYX_TO_CURLYM
                      && OP(oscan) == CURLYX
                      && data
+                     && !pRExC_state->code_blocks /* XXX: for now disable whenever eval
+                                                     is seen anywhere. We need a better
+                                                     way. */
                      && !(data->flags & (SF_HAS_PAR|SF_HAS_EVAL))
                      && !deltanext     /* atom is fixed width */
                      && minnext != 0  /* CURLYM can't handle zero width */
@@ -2753,6 +2761,7 @@ Perl_study_chunk(pTHX_
                      && !(RExC_seen & REG_UNFOLDED_MULTI_SEEN)
                      && mutate_ok
                 ) {
+                    DEBUG_STUDYDATA("CURLYX_TO_CURLYM", data, depth, is_inf, min, stopmin, delta);
                     /* XXXX How to optimize if data == 0? */
                     /* Optimize to a simpler form.  */
                     regnode *nxt = REGNODE_AFTER_type(oscan, tregnode_CURLYX); /* OPEN */

t/re/pat_re_eval.t

@@ -168,7 +168,9 @@ sub run_tests {
             [ 1, qr#^((??{"(?:bla|)"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
             [ 1, qr#^((??{"(?!)?"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
             [ 1, qr#^((??{"(?:|<(/?bla)>)"}))((??{$nested_tags}))\1$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
-            [ 0, qr#^((??{"(?!)"}))?((??{$nested_tags}))(?!)$#, "bla blubb undef", "a b undef" ],
+            [ 0, qr#^((??{"(?!)"}))?((??{$nested_tags}))(?!)$#, # changed in perl 5.37.7
+                 "bla blubb blub blu bl b bl b undef",
+                 "a b b u l b l b undef" ],
 
         ) { #"#silence vim highlighting
             $c++;