Assimilate Cwd 2.15 from CPAN
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index bed697d..0c688da 100644 (file)
--- a/op.c
+++ b/op.c
@@ -216,7 +216,7 @@ Perl_op_free(pTHX_ OP *o)
     register OP *kid, *nextkid;
     OPCODE type;
 
-    if (!o || o->op_seq == (U16)-1)
+    if (!o || o->op_static)
        return;
 
     if (o->op_private & OPpREFCOUNTED) {
@@ -275,17 +275,20 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_GVSV:
     case OP_GV:
     case OP_AELEMFAST:
+       if (! (o->op_type == OP_AELEMFAST && o->op_flags & OPf_SPECIAL)) {
+           /* not an OP_PADAV replacement */
 #ifdef USE_ITHREADS
-       if (cPADOPo->op_padix > 0) {
-           /* No GvIN_PAD_off(cGVOPo_gv) here, because other references
-            * may still exist on the pad */
-           pad_swipe(cPADOPo->op_padix, TRUE);
-           cPADOPo->op_padix = 0;
-       }
+           if (cPADOPo->op_padix > 0) {
+               /* No GvIN_PAD_off(cGVOPo_gv) here, because other references
+                * may still exist on the pad */
+               pad_swipe(cPADOPo->op_padix, TRUE);
+               cPADOPo->op_padix = 0;
+           }
 #else
-       SvREFCNT_dec(cSVOPo->op_sv);
-       cSVOPo->op_sv = Nullsv;
+           SvREFCNT_dec(cSVOPo->op_sv);
+           cSVOPo->op_sv = Nullsv;
 #endif
+       }
        break;
     case OP_METHOD_NAMED:
     case OP_CONST:
@@ -294,7 +297,7 @@ Perl_op_clear(pTHX_ OP *o)
 #ifdef USE_ITHREADS
        /** Bug #15654
          Even if op_clear does a pad_free for the target of the op,
-         pad_free doesn't actually remove the sv that exists in the bad
+         pad_free doesn't actually remove the sv that exists in the pad;
          instead it lives on. This results in that it could be reused as 
          a target later on when the pad was reallocated.
        **/
@@ -674,10 +677,14 @@ Perl_scalarvoid(pTHX_ OP *o)
        else {
            if (ckWARN(WARN_VOID)) {
                useless = "a constant";
+               /* don't warn on optimised away booleans, eg 
+                * use constant Foo, 5; Foo || print; */
+               if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
+                   useless = 0;
                /* the constants 0 and 1 are permitted as they are
                   conventionally used as dummies in constructs like
                        1 while some_condition_with_side_effects;  */
-               if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
+               else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
                    useless = 0;
                else if (SvPOK(sv)) {
                   /* perl4's way of mixing documentation and code
@@ -1108,7 +1115,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
        break;
 
     case OP_AELEMFAST:
-       localize = 1;
+       localize = -1;
        PL_modcount++;
        break;
 
@@ -2022,7 +2029,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
     o->op_ppaddr = PL_ppaddr[OP_RV2AV];
     o->op_flags &= ~OPf_REF;   /* treat \(1..2) like an ordinary list */
     o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
-    o->op_seq = 0;             /* needs to be revisited in peep() */
+    o->op_opt = 0;             /* needs to be revisited in peep() */
     curop = ((UNOP*)o)->op_first;
     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
     op_free(curop);
@@ -3360,11 +3367,13 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
            op_free(first);
            *firstp = Nullop;
+           other->op_private |= OPpCONST_SHORTCIRCUIT;
            return other;
        }
        else {
            op_free(other);
            *otherp = Nullop;
+           first->op_private |= OPpCONST_SHORTCIRCUIT;
            return first;
        }
     }
@@ -3574,6 +3583,10 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
        }
     }
 
+    /* if block is null, the next append_elem() would put UNSTACK, a scalar
+     * op, in listop. This is wrong. [perl #27024] */
+    if (!block)
+       block = newOP(OP_NULL, 0);
     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
     o = new_logop(OP_AND, 0, &expr, &listop);
 
@@ -3724,7 +3737,6 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
        }
        else {
            padoff = offset;
-           iterpflags = OPpLVAL_INTRO; /* my $_; for () */
        }
     }
     if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
@@ -6306,25 +6318,21 @@ Perl_peep(pTHX_ register OP *o)
 {
     register OP* oldop = 0;
 
-    if (!o || o->op_seq)
+    if (!o || o->op_opt)
        return;
     ENTER;
     SAVEOP();
     SAVEVPTR(PL_curcop);
     for (; o; o = o->op_next) {
-       if (o->op_seq)
+       if (o->op_opt)
            break;
-        /* The special value -1 is used by the B::C compiler backend to indicate
-         * that an op is statically defined and should not be freed */
-       if (!PL_op_seqmax || PL_op_seqmax == (U16)-1)
-           PL_op_seqmax = 1;
        PL_op = o;
        switch (o->op_type) {
        case OP_SETSTATE:
        case OP_NEXTSTATE:
        case OP_DBSTATE:
            PL_curcop = ((COP*)o);              /* for warnings */
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            break;
 
        case OP_CONST:
@@ -6355,7 +6363,7 @@ Perl_peep(pTHX_ register OP *o)
                o->op_targ = ix;
            }
 #endif
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            break;
 
        case OP_CONCAT:
@@ -6373,11 +6381,11 @@ Perl_peep(pTHX_ register OP *o)
                op_null(o->op_next);
            }
          ignore_optimization:
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            break;
        case OP_STUB:
            if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
-               o->op_seq = PL_op_seqmax++;
+               o->op_opt = 1;
                break; /* Scalar stub must produce undef.  List stub is noop */
            }
            goto nothin;
@@ -6392,6 +6400,7 @@ Perl_peep(pTHX_ register OP *o)
               to peep() from mistakenly concluding that optimisation
               has already occurred. This doesn't fix the real problem,
               though (See 20010220.007). AMS 20010719 */
+           /* op_seq functionality is now replaced by op_opt */
            if (oldop && o->op_next) {
                oldop->op_next = o->op_next;
                continue;
@@ -6405,22 +6414,14 @@ Perl_peep(pTHX_ register OP *o)
                oldop->op_next = o->op_next;
                continue;
            }
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            break;
 
+       case OP_PADAV:
        case OP_GV:
-           if (o->op_next->op_type == OP_RV2SV) {
-               if (!(o->op_next->op_private & OPpDEREF)) {
-                   op_null(o->op_next);
-                   o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
-                                                              | OPpOUR_INTRO);
-                   o->op_next = o->op_next->op_next;
-                   o->op_type = OP_GVSV;
-                   o->op_ppaddr = PL_ppaddr[OP_GVSV];
-               }
-           }
-           else if (o->op_next->op_type == OP_RV2AV) {
-               OP* pop = o->op_next->op_next;
+           if (o->op_type == OP_PADAV || o->op_next->op_type == OP_RV2AV) {
+               OP* pop = (o->op_type == OP_PADAV) ?
+                           o->op_next : o->op_next->op_next;
                IV i;
                if (pop && pop->op_type == OP_CONST &&
                    (PL_op = pop->op_next) &&
@@ -6432,16 +6433,34 @@ Perl_peep(pTHX_ register OP *o)
                    i >= 0)
                {
                    GV *gv;
-                   op_null(o->op_next);
+                   if (o->op_type == OP_GV)
+                       op_null(o->op_next);
                    op_null(pop->op_next);
                    op_null(pop);
                    o->op_flags |= pop->op_next->op_flags & OPf_MOD;
                    o->op_next = pop->op_next->op_next;
-                   o->op_type = OP_AELEMFAST;
                    o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
                    o->op_private = (U8)i;
-                   gv = cGVOPo_gv;
-                   GvAVn(gv);
+                   if (o->op_type == OP_GV) {
+                       gv = cGVOPo_gv;
+                       GvAVn(gv);
+                   }
+                   else
+                       o->op_flags |= OPf_SPECIAL;
+                   o->op_type = OP_AELEMFAST;
+               }
+               o->op_opt = 1;
+               break;
+           }
+
+           if (o->op_next->op_type == OP_RV2SV) {
+               if (!(o->op_next->op_private & OPpDEREF)) {
+                   op_null(o->op_next);
+                   o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
+                                                              | OPpOUR_INTRO);
+                   o->op_next = o->op_next->op_next;
+                   o->op_type = OP_GVSV;
+                   o->op_ppaddr = PL_ppaddr[OP_GVSV];
                }
            }
            else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
@@ -6467,7 +6486,7 @@ Perl_peep(pTHX_ register OP *o)
                op_null(o->op_next);
            }
 
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            break;
 
        case OP_MAPWHILE:
@@ -6480,7 +6499,7 @@ Perl_peep(pTHX_ register OP *o)
        case OP_DORASSIGN:
        case OP_COND_EXPR:
        case OP_RANGE:
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
            peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
@@ -6488,7 +6507,7 @@ Perl_peep(pTHX_ register OP *o)
 
        case OP_ENTERLOOP:
        case OP_ENTERITER:
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            while (cLOOP->op_redoop->op_type == OP_NULL)
                cLOOP->op_redoop = cLOOP->op_redoop->op_next;
            peep(cLOOP->op_redoop);
@@ -6503,7 +6522,7 @@ Perl_peep(pTHX_ register OP *o)
        case OP_QR:
        case OP_MATCH:
        case OP_SUBST:
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            while (cPMOP->op_pmreplstart &&
                   cPMOP->op_pmreplstart->op_type == OP_NULL)
                cPMOP->op_pmreplstart = cPMOP->op_pmreplstart->op_next;
@@ -6511,7 +6530,7 @@ Perl_peep(pTHX_ register OP *o)
            break;
 
        case OP_EXEC:
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            if (ckWARN(WARN_SYNTAX) && o->op_next
                && o->op_next->op_type == OP_NEXTSTATE) {
                if (o->op_next->op_sibling &&
@@ -6536,7 +6555,7 @@ Perl_peep(pTHX_ register OP *o)
            char *key = NULL;
            STRLEN keylen;
 
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
 
            if (((BINOP*)o)->op_last->op_type != OP_CONST)
                break;
@@ -6561,7 +6580,7 @@ Perl_peep(pTHX_ register OP *o)
            OP *oleft, *oright;
            OP *o2;
 
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
 
            /* check that RHS of sort is a single plain array */
            oright = cUNOPo->op_first;
@@ -6645,7 +6664,7 @@ Perl_peep(pTHX_ register OP *o)
 
 
        default:
-           o->op_seq = PL_op_seqmax++;
+           o->op_opt = 1;
            break;
        }
        oldop = o;