This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
in re_op_compile(), keep code_blocks for qr//
authorDavid Mitchell <davem@iabyn.com>
Fri, 25 Nov 2011 11:29:33 +0000 (11:29 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 13 Jun 2012 12:32:46 +0000 (13:32 +0100)
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.

regcomp.c
regcomp.h
regexp.h

index 391e72b..4463c11 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
 #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;
 
index 536ad83..d7261db 100644 (file)
--- a/regcomp.h
+++ b/regcomp.h
@@ -121,6 +121,8 @@ typedef OP OP_4tree;                        /* Will be redefined later. */
                                    Used to make it easier to clone and free arbitrary
                                    data that the regops need. Often the ARG field of
                                    a regop is an index into this structure */
+       struct reg_code_block *code_blocks;/* positions of literal (?{}) */
+       int num_code_blocks;    /* size of code_blocks[] */
        regnode program[1];     /* Unwarranted chumminess with compiler. */
 } regexp_internal;
 
index 982e69c..29f11c0 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -64,6 +64,15 @@ typedef struct regexp_paren_pair {
 #define _invlist_subtract(a, b, output) _invlist_intersection_maybe_complement_2nd(a, b, TRUE, output)
 #endif
 
+/* record the position of a (?{...}) within a pattern */
+
+struct reg_code_block {
+    STRLEN start;
+    STRLEN end;
+    OP     *block;
+};
+
+
 /*
   The regexp/REGEXP struct, see L<perlreapi> for further documentation
   on the individual fields. The struct is ordered so that the most
@@ -110,7 +119,7 @@ typedef struct regexp_paren_pair {
        PERL_BITFIELD32 pre_prefix:4;                                   \
        /* number of eval groups in the pattern - for security checks */\
        PERL_BITFIELD32 seen_evals:28;                                  \
-       CV *qr_anoncv   /* the anon sub wrapped round qr/(?{..})/ */
+       CV *qr_anoncv;  /* the anon sub wrapped round qr/(?{..})/ */    \
 
 typedef struct regexp {
        _XPV_HEAD;