add verbose stack display option, -Dvs

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

diff --git a/op.c b/op.c
index 0a8c0a2..75cff4b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1243,6 +1243,7 @@ Perl_scalarvoid(pTHX_ OP *o)
 
     case OP_OR:
     case OP_AND:
+    case OP_DOR:
     case OP_COND_EXPR:
        for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
            scalarvoid(kid);
@@ -1612,7 +1613,6 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_AASSIGN:
     case OP_NEXTSTATE:
     case OP_DBSTATE:
-    case OP_CHOMP:
        PL_modcount = RETURN_UNLIMITED_NUMBER;
        break;
     case OP_RV2SV:
@@ -1626,6 +1626,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_SASSIGN:
     case OP_ANDASSIGN:
     case OP_ORASSIGN:
+    case OP_DORASSIGN:
     case OP_AELEMFAST:
        PL_modcount++;
        break;
@@ -2088,19 +2089,19 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     } else if (type == OP_RV2SV ||     /* "our" declaration */
               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 my", OP_DESC(o)));
-        }
-        if (attrs) {
-            GV *gv = cGVOPx_gv(cUNOPo->op_first);
-            PL_in_my = FALSE;
-            PL_in_my_stash = Nullhv;
-            apply_attrs(GvSTASH(gv),
-                        (type == OP_RV2SV ? GvSV(gv) :
-                         type == OP_RV2AV ? (SV*)GvAV(gv) :
-                         type == OP_RV2HV ? (SV*)GvHV(gv) : (SV*)gv),
-                        attrs, FALSE);
-        }
+       if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */
+           yyerror(Perl_form(aTHX_ "Can't declare %s in %s",
+                       OP_DESC(o), PL_in_my == KEY_our ? "our" : "my"));
+       } else if (attrs) {
+           GV *gv = cGVOPx_gv(cUNOPo->op_first);
+           PL_in_my = FALSE;
+           PL_in_my_stash = Nullhv;
+           apply_attrs(GvSTASH(gv),
+                       (type == OP_RV2SV ? GvSV(gv) :
+                        type == OP_RV2AV ? (SV*)GvAV(gv) :
+                        type == OP_RV2HV ? (SV*)GvHV(gv) : (SV*)gv),
+                       attrs, FALSE);
+       }
        o->op_private |= OPpOUR_INTRO;
        return o;
     }
@@ -3617,7 +3618,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
     OP *o;
 
     if (optype) {
-       if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
+       if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN || optype == OP_DORASSIGN) {
            return newLOGOP(optype, 0,
                mod(scalar(left), optype),
                newUNOP(OP_SASSIGN, 0, scalar(right)));
@@ -3940,7 +3941,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     if (!other)
        return first;
 
-    if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
+    if (type == OP_ANDASSIGN || type == OP_ORASSIGN || type == OP_DORASSIGN)
        other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
 
     NewOp(1101, logop, 1, LOGOP);
@@ -3977,6 +3978,10 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 
     scalarboolean(first);
     if (first->op_type == OP_CONST) {
+        if (first->op_private & OPpCONST_BARE &&
+           first->op_private & OPpCONST_STRICT) {
+           no_bareword_allowed(first);
+       }
        if (SvTRUE(((SVOP*)first)->op_sv)) {
            op_free(first);
            op_free(falseop);
@@ -7141,8 +7146,10 @@ Perl_peep(pTHX_ register OP *o)
        case OP_GREPWHILE:
        case OP_AND:
        case OP_OR:
+       case OP_DOR:
        case OP_ANDASSIGN:
        case OP_ORASSIGN:
+       case OP_DORASSIGN:
        case OP_COND_EXPR:
        case OP_RANGE:
            o->op_seq = PL_op_seqmax++;