Re: Named-capture regex syntax

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 32bf1d8..8aca413 100644 (file)
--- a/op.c
+++ b/op.c
@@ -277,6 +277,20 @@ Perl_allocmy(pTHX_ const char *const name)
     return off;
 }
 
+/* free the body of an op without examining its contents.
+ * Always use this rather than FreeOp directly */
+
+void
+S_op_destroy(pTHX_ OP *o)
+{
+    if (o->op_latefree) {
+       o->op_latefreed = 1;
+       return;
+    }
+    FreeOp(o);
+}
+
+
 /* Destructor */
 
 void
@@ -287,6 +301,11 @@ Perl_op_free(pTHX_ OP *o)
 
     if (!o || o->op_static)
        return;
+    if (o->op_latefreed) {
+       if (o->op_latefree)
+           return;
+       goto do_free;
+    }
 
     type = o->op_type;
     if (o->op_private & OPpREFCOUNTED) {
@@ -327,6 +346,11 @@ Perl_op_free(pTHX_ OP *o)
        cop_free((COP*)o);
 
     op_clear(o);
+    if (o->op_latefree) {
+       o->op_latefreed = 1;
+       return;
+    }
+  do_free:
     FreeOp(o);
 #ifdef DEBUG_LEAKING_SCALARS
     if (PL_op == o)
@@ -490,16 +514,7 @@ clear_pmop:
 STATIC void
 S_cop_free(pTHX_ COP* cop)
 {
-    if (cop->cop_label) {
-#ifdef PERL_TRACK_MEMPOOL
-       Malloc_t ptr = (Malloc_t)(cop->cop_label - sTHX);
-       struct perl_memory_debug_header *const header
-               = (struct perl_memory_debug_header *)ptr;
-       /* Only the thread that allocated us can free us. */
-       if (header->interpreter == aTHX)
-#endif
-           Safefree(cop->cop_label);
-    }
+    CopLABEL_free(cop);
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
@@ -1778,7 +1793,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
               type == OP_RV2AV ||
               type == OP_RV2HV) { /* XXX does this let anything illegal in? */
        if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */
-           yyerror(Perl_form(aTHX_ "Can't declare %s in %s",
+           yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",
                        OP_DESC(o),
                        PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
        } else if (attrs) {
@@ -2031,7 +2046,7 @@ Perl_newPROG(pTHX_ OP *o)
        if (o->op_type == OP_STUB) {
            PL_comppad_name = 0;
            PL_compcv = 0;
-           FreeOp(o);
+           S_op_destroy(aTHX_ o);
            return;
        }
        PL_main_root = scope(sawparens(scalarvoid(o)));
@@ -2373,7 +2388,7 @@ Perl_append_list(pTHX_ I32 type, LISTOP *first, LISTOP *last)
     last->op_madprop = 0;
 #endif
 
-    FreeOp(last);
+    S_op_destroy(aTHX_ (OP*)last);
 
     return (OP*)first;
 }
@@ -2709,6 +2724,8 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
     o->op_type = (OPCODE)type;
     o->op_ppaddr = PL_ppaddr[type];
     o->op_flags = (U8)flags;
+    o->op_latefree = 0;
+    o->op_latefreed = 0;
 
     o->op_next = o;
     o->op_private = (U8)(0 | (flags >> 8));
@@ -2797,7 +2814,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 {
     dVAR;
     SV * const tstr = ((SVOP*)expr)->op_sv;
-    SV * const rstr = ((SVOP*)repl)->op_sv;
+    SV * const rstr =
+#ifdef PERL_MAD
+                       (repl->op_type == OP_NULL)
+                           ? ((SVOP*)((LISTOP*)repl)->op_first)->op_sv :
+#endif
+                             ((SVOP*)repl)->op_sv;
     STRLEN tlen;
     STRLEN rlen;
     const U8 *t = (U8*)SvPV_const(tstr, tlen);
@@ -3004,6 +3026,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            bits = 8;
 
        Safefree(cPVOPo->op_pv);
+       cPVOPo->op_pv = NULL;
        cSVOPo->op_sv = (SV*)swash_init("utf8", "", listsv, bits, none);
        SvREFCNT_dec(listsv);
        SvREFCNT_dec(transv);
@@ -3290,7 +3313,9 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
        else {
            OP *lastop = NULL;
            for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
-               if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
+               if (curop->op_type == OP_SCOPE
+                       || curop->op_type == OP_LEAVE
+                       || (PL_opargs[curop->op_type] & OA_DANGEROUS)) {
                    if (curop->op_type == OP_GV) {
                        GV * const gv = cGVOPx_gv(curop);
                        repl_has_vars = 1;
@@ -3309,7 +3334,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
                    else if (curop->op_type == OP_PADSV ||
                             curop->op_type == OP_PADAV ||
                             curop->op_type == OP_PADHV ||
-                            curop->op_type == OP_PADANY) {
+                            curop->op_type == OP_PADANY)
+                   {
                        repl_has_vars = 1;
                    }
                    else if (curop->op_type == OP_PUSHRE)
@@ -3323,7 +3349,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
        if (curop == repl
            && !(repl_has_vars
                 && (!PM_GETRE(pm)
-                    || PM_GETRE(pm)->reganch & ROPT_EVAL_SEEN))) {
+                    || PM_GETRE(pm)->extflags & RXf_EVAL_SEEN)))
+       {
            pm->op_pmflags |= PMf_CONST;        /* const for long enough */
            pm->op_pmpermflags |= PMf_CONST;    /* const for long enough */
            prepend_elem(o->op_type, scalar(repl), o);
@@ -3969,7 +3996,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     cop->op_next = (OP*)cop;
 
     if (label) {
-       cop->cop_label = label;
+       CopLABEL_set(cop, label);
        PL_hints |= HINT_BLOCK_SCOPE;
     }
     cop->cop_seq = seq;
@@ -3998,10 +4025,13 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     CopSTASH_set(cop, PL_curstash);
 
     if (PERLDB_LINE && PL_curstash != PL_debstash) {
-       SV * const * const svp = av_fetch(CopFILEAVx(PL_curcop), (I32)CopLINE(cop), FALSE);
-       if (svp && *svp != &PL_sv_undef ) {
-           (void)SvIOK_on(*svp);
-           SvIV_set(*svp, PTR2IV(cop));
+       AV *av = CopFILEAVx(PL_curcop);
+       if (av) {
+           SV * const * const svp = av_fetch(av, (I32)CopLINE(cop), FALSE);
+           if (svp && *svp != &PL_sv_undef ) {
+               (void)SvIOK_on(*svp);
+               SvIV_set(*svp, PTR2IV(cop));
+           }
        }
     }
 
@@ -4560,7 +4590,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
        LOOP *tmp;
        NewOp(1234,tmp,1,LOOP);
        Copy(loop,tmp,1,LISTOP);
-       FreeOp(loop);
+       S_op_destroy(aTHX_ (OP*)loop);
        loop = tmp;
     }
 #else
@@ -4800,7 +4830,7 @@ Perl_cv_undef(pTHX_ CV *cv)
        /* for XSUBs CvFILE point directly to static memory; __FILE__ */
        Safefree(CvFILE(cv));
     }
-    CvFILE(cv) = 0;
+    CvFILE(cv) = NULL;
 #endif
 
     if (!CvISXSUB(cv) && CvROOT(cv)) {