in re_op_compile(), keep code_blocks for qr//

code_blocks is a temporary list of start/end indices and pointers to DO
blocks, that is used during the regexp compilation. Change it so that in
the qr// case, this structure is preserved (attached to regexp_internal),
so that in a forthcoming commit it will be available for use when
interpolating a qr within another pattern.

1 files changed, 27 insertions, 10 deletions

diff --git a/regcomp.c b/regcomp.c
index 391e72b95e..4463c1178a 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -109,12 +109,6 @@
 #define	STATIC	static
 #endif
 
-struct code_block {
-    STRLEN start;
-    STRLEN end;
-    OP     *block;
-} ;
-
 
 typedef struct RExC_state_t {
     U32		flags;			/* are we folding, multilining? */
@@ -156,7 +150,7 @@ typedef struct RExC_state_t {
     I32		in_lookbehind;
     I32		contains_locale;
     I32		override_recoding;
-    struct code_block *code_blocks;	/* positions of literal (?{})
+    struct reg_code_block *code_blocks;	/* positions of literal (?{})
 					    within pattern */
     int		num_code_blocks;	/* size of code_blocks[] */
     int		code_index;		/* next code_blocks[] slot */
@@ -5134,8 +5128,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
 	}
 	if (ncode) {
 	    pRExC_state->num_code_blocks = ncode;
-	    Newx(pRExC_state->code_blocks, ncode, struct code_block);
-	    SAVEFREEPV(pRExC_state->code_blocks);
+	    Newx(pRExC_state->code_blocks, ncode, struct reg_code_block);
 	}
     }
 
@@ -5235,6 +5228,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
 		if (is_bare_re)
 		    *is_bare_re = 1;
 		SvREFCNT_inc(re);
+		Safefree(pRExC_state->code_blocks);
 		return (REGEXP*)re;
 	    }
 	}
@@ -5291,6 +5285,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
 	    pat = newSVpvn_flags(exp, plen, SVs_TEMP |
 					(IN_BYTES ? 0 : SvUTF8(pat)));
 	}
+	Safefree(pRExC_state->code_blocks);
 	return CALLREGCOMP_ENG(eng, pat, orig_pm_flags);
     }
 
@@ -5300,6 +5295,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
 	&& memEQ(RX_PRECOMP(old_re), exp, plen))
     {
 	ReREFCNT_inc(old_re);
+	Safefree(pRExC_state->code_blocks);
 	return old_re;
     }
 
@@ -5401,6 +5397,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
 	    if (used_setjump) {
 		JMPENV_POP;
 	    }
+	    Safefree(pRExC_state->code_blocks);
 	    return old_re;
 	}
 
@@ -5461,6 +5458,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
     DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Starting first pass (sizing)\n"));
     if (reg(pRExC_state, 0, &flags,1) == NULL) {
 	RExC_precomp = NULL;
+	Safefree(pRExC_state->code_blocks);
 	return(NULL);
     }
 
@@ -5515,6 +5513,13 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
     RXi_SET( r, ri );
     r->engine= RE_ENGINE_PTR;
     r->extflags = pm_flags;
+    if (orig_pm_flags & PMf_HAS_CV) {
+	ri->code_blocks = pRExC_state->code_blocks;
+	ri->num_code_blocks = pRExC_state->num_code_blocks;
+    }
+    else
+	SAVEFREEPV(pRExC_state->code_blocks);
+
     {
         bool has_p     = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
         bool has_charset = (get_regex_charset(r->extflags) != REGEX_DEPENDS_CHARSET);
@@ -13272,6 +13277,9 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx)
     if (ri->u.offsets)
         Safefree(ri->u.offsets);             /* 20010421 MJD */
 #endif
+    if (ri->code_blocks)
+	Safefree(ri->code_blocks);
+
     if (ri->data) {
 	int n = ri->data->count;
 	PAD* new_comppad = NULL;
@@ -13501,7 +13509,16 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param)
     
     Newxc(reti, sizeof(regexp_internal) + len*sizeof(regnode), char, regexp_internal);
     Copy(ri->program, reti->program, len+1, regnode);
-    
+
+    reti->num_code_blocks = ri->num_code_blocks;
+    if (ri->code_blocks) {
+	Newxc(reti->code_blocks, ri->num_code_blocks, struct reg_code_block,
+		struct reg_code_block);
+	Copy(ri->code_blocks, reti->code_blocks, ri->num_code_blocks,
+		struct reg_code_block);
+    }
+    else
+	reti->code_blocks = NULL;
 
     reti->regstclass = NULL;