Update copyright years to include 2007. (Plus a couple of 2006s and

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

diff --git a/op.c b/op.c
index 03f54b1..b0a0c0f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1,7 +1,7 @@
 /*    op.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -514,19 +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);
-           cop->cop_label = NULL;
-       }
-    }
+    CopLABEL_free(cop);
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
@@ -2738,6 +2726,7 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
     o->op_flags = (U8)flags;
     o->op_latefree = 0;
     o->op_latefreed = 0;
+    o->op_attached = 0;
 
     o->op_next = o;
     o->op_private = (U8)(0 | (flags >> 8));
@@ -2826,9 +2815,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 {
     dVAR;
     SV * const tstr = ((SVOP*)expr)->op_sv;
-    SV * const rstr = (repl->op_type == OP_NULL)
-                           ? ((SVOP*)((LISTOP*)repl)->op_first)->op_sv
-                           : ((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);
@@ -3322,7 +3314,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;
@@ -3341,7 +3335,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)
@@ -3355,7 +3350,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
        if (curop == repl
            && !(repl_has_vars
                 && (!PM_GETRE(pm)
-                    || PM_GETRE(pm)->extflags & RXf_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);
@@ -3823,7 +3819,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
         * that value, we know we've got commonality.  We could use a
         * single bit marker, but then we'd have to make 2 passes, first
         * to clear the flag, then to test and set it.  To find somewhere
-        * to store these values, evil chicanery is done with SvCUR().
+        * to store these values, evil chicanery is done with SvUVX().
         */
 
        {
@@ -4001,7 +3997,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;
@@ -4531,8 +4527,14 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
        }
        else
            Perl_croak(aTHX_ "Can't use %s for loop variable", PL_op_desc[sv->op_type]);
-       if (padoff && strEQ(PAD_COMPNAME_PV(padoff), "$_"))
-           iterpflags |= OPpITER_DEF;
+       if (padoff) {
+           SV *const namesv = PAD_COMPNAME_SV(padoff);
+           STRLEN len;
+           const char *const name = SvPV_const(namesv, len);
+
+           if (len == 2 && name[0] == '$' && name[1] == '_')
+               iterpflags |= OPpITER_DEF;
+       }
     }
     else {
         const PADOFFSET offset = pad_findmy("$_");
@@ -5322,6 +5324,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (CvLVALUE(cv)) {
        CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
                             mod(scalarseq(block), OP_LEAVESUBLV));
+       block->op_attached = 1;
     }
     else {
        /* This makes sub {}; work as expected.  */
@@ -5334,6 +5337,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 #endif
            block = newblock;
        }
+       else
+           block->op_attached = 1;
        CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
     }
     CvROOT(cv)->op_private |= OPpREFCOUNTED;
@@ -6452,13 +6457,9 @@ Perl_ck_fun(pTHX_ OP *o)
                             */
                            priv = OPpDEREF;
                            if (kid->op_type == OP_PADSV) {
-                               name = PAD_COMPNAME_PV(kid->op_targ);
-                               /* SvCUR of a pad namesv can't be trusted
-                                * (see PL_generation), so calc its length
-                                * manually */
-                               if (name)
-                                   len = strlen(name);
-
+                               SV *const namesv
+                                   = PAD_COMPNAME_SV(kid->op_targ);
+                               name = SvPV_const(namesv, len);
                            }
                            else if (kid->op_type == OP_RV2SV
                                     && kUNOP->op_first->op_type == OP_GV)