add $Config('scriptdir'} on VMS

[perl5.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index 3241444..9877658 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -1076,7 +1076,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                }
                if (!scan)              /* It was not CURLYX, but CURLY. */
                    scan = next;
-               if (ckWARN(WARN_REGEXP) && (minnext + deltanext == 0)
+               if (ckWARN(WARN_REGEXP)
+                   && (minnext == 0) && (deltanext == 0)
                    && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
                    && maxcount <= REG_INFTY/3) /* Complement check for big count */
                {
@@ -1098,7 +1099,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                      && !deltanext && minnext == 1 ) {
                    /* Try to optimize to CURLYN.  */
                    regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
-                   regnode *nxt1 = nxt, *nxt2;
+                   regnode *nxt1 = nxt;
+#ifdef DEBUGGING
+                   regnode *nxt2;
+#endif
 
                    /* Skip open. */
                    nxt = regnext(nxt);
@@ -1106,7 +1110,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                        && !(PL_regkind[(U8)OP(nxt)] == EXACT
                             && STR_LEN(nxt) == 1))
                        goto nogo;
+#ifdef DEBUGGING
                    nxt2 = nxt;
+#endif
                    nxt = regnext(nxt);
                    if (OP(nxt) != CLOSE)
                        goto nogo;
@@ -1740,6 +1746,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     RExC_rx = r;
 
     /* Second pass: emit code. */
+    RExC_flags16 = pm->op_pmflags;     /* don't let top level (?i) bleed */
     RExC_parse = exp;
     RExC_end = xend;
     RExC_naughty = 0;
@@ -2007,8 +2014,8 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
        r->reganch |= ROPT_LOOKBEHIND_SEEN;
     if (RExC_seen & REG_SEEN_EVAL)
        r->reganch |= ROPT_EVAL_SEEN;
-    if (RExC_seen & REG_SEEN_SANY)
-       r->reganch |= ROPT_SANY_SEEN;
+    if (RExC_seen & REG_SEEN_CANY)
+       r->reganch |= ROPT_CANY_SEEN;
     Newz(1002, r->startp, RExC_npar, I32);
     Newz(1002, r->endp, RExC_npar, I32);
     PL_regdata = r->data; /* for regprop() */
@@ -2132,6 +2139,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                    ENTER;
                    Perl_save_re_context(aTHX);
                    rop = sv_compile_2op(sv, &sop, "re", &av);
+                   sop->op_private |= OPpREFCOUNTED;
+                   /* re_dup will OpREFCNT_inc */
+                   OpREFCNT_set(sop, 1);
                    LEAVE;
 
                    n = add_data(pRExC_state, 3, "nop");
@@ -2677,6 +2687,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
 {
     register regnode *ret = 0;
     I32 flags;
+    char *parse_start = 0;
 
     *flagp = WORST;            /* Tentatively. */
 
@@ -2794,8 +2805,8 @@ tryagain:
             Set_Node_Length(ret, 2); /* MJD */
            break;
        case 'C':
-           ret = reg_node(pRExC_state, SANY);
-           RExC_seen |= REG_SEEN_SANY;
+           ret = reg_node(pRExC_state, CANY);
+           RExC_seen |= REG_SEEN_CANY;
            *flagp |= HASWIDTH|SIMPLE;
            nextchar(pRExC_state);
             Set_Node_Length(ret, 2); /* MJD */
@@ -2950,7 +2961,8 @@ tryagain:
            register char *p;
            char *oldp, *s;
            STRLEN numlen;
-            char *parse_start = RExC_parse - 1;
+
+            parse_start = RExC_parse - 1;
 
            RExC_parse++;
 
@@ -4343,7 +4355,7 @@ Perl_regdump(pTHX_ regexp *r)
 STATIC void
 S_put_byte(pTHX_ SV *sv, int c)
 {
-    if (isCNTRL(c) || c == 127 || c == 255 || !isPRINT(c))
+    if (isCNTRL(c) || c == 255 || !isPRINT(c))
        Perl_sv_catpvf(aTHX_ sv, "\\%o", c);
     else if (c == '-' || c == ']' || c == '\\' || c == '^')
        Perl_sv_catpvf(aTHX_ sv, "\\%c", c);
@@ -4578,6 +4590,7 @@ Perl_pregfree(pTHX_ struct regexp *r)
        SV** old_curpad;
 
        while (--n >= 0) {
+          /* If you add a ->what type here, update the comment in regcomp.h */
            switch (r->data->what[n]) {
            case 's':
                SvREFCNT_dec((SV*)r->data->data[n]);
@@ -4600,7 +4613,11 @@ Perl_pregfree(pTHX_ struct regexp *r)
                }
                else
                    PL_curpad = NULL;
-               op_free((OP_4tree*)r->data->data[n]);
+
+               if (!OpREFCNT_dec((OP_4tree*)r->data->data[n])) {
+                    op_free((OP_4tree*)r->data->data[n]);
+               }
+
                PL_comppad = old_comppad;
                PL_curpad = old_curpad;
                SvREFCNT_dec((SV*)new_comppad);
@@ -4718,6 +4735,7 @@ Perl_save_re_context(pTHX)
     SAVEVPTR(PL_reg_re);               /* from regexec.c */
     SAVEPPTR(PL_reg_ganch);            /* from regexec.c */
     SAVESPTR(PL_reg_sv);               /* from regexec.c */
+    SAVEI32(PL_reg_sv_utf8);           /* from regexec.c */
     SAVEVPTR(PL_reg_magic);            /* from regexec.c */
     SAVEI32(PL_reg_oldpos);                    /* from regexec.c */
     SAVEVPTR(PL_reg_oldcurpm);         /* from regexec.c */