Make C++ compilers happy #3: make implicit cast

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 728be10..b8a6143 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1138,6 +1138,20 @@ Perl_scalarvoid(pTHX_ OP *o)
 
     case OP_OR:
     case OP_AND:
+       kid = cLOGOPo->op_first;
+       if (kid->op_type == OP_NOT
+           && (kid->op_flags & OPf_KIDS)
+           && !PL_madskills) {
+           if (o->op_type == OP_AND) {
+               o->op_type = OP_OR;
+               o->op_ppaddr = PL_ppaddr[OP_OR];
+           } else {
+               o->op_type = OP_AND;
+               o->op_ppaddr = PL_ppaddr[OP_AND];
+           }
+           op_null(kid);
+       }
+
     case OP_DOR:
     case OP_COND_EXPR:
     case OP_ENTERGIVEN:
@@ -4436,46 +4450,95 @@ Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other)
 }
 
 STATIC OP *
+S_search_const(pTHX_ OP *o)
+{
+    PERL_ARGS_ASSERT_SEARCH_CONST;
+
+    switch (o->op_type) {
+       case OP_CONST:
+           return o;
+       case OP_NULL:
+           if (o->op_flags & OPf_KIDS)
+               return search_const(cUNOPo->op_first);
+           break;
+       case OP_LEAVE:
+       case OP_SCOPE:
+       case OP_LINESEQ:
+       {
+           OP *kid;
+           if (!(o->op_flags & OPf_KIDS))
+               return NULL;
+           kid = cLISTOPo->op_first;
+           do {
+               switch (kid->op_type) {
+                   case OP_ENTER:
+                   case OP_NULL:
+                   case OP_NEXTSTATE:
+                       kid = kid->op_sibling;
+                       break;
+                   default:
+                       if (kid != cLISTOPo->op_last)
+                           return NULL;
+                       goto last;
+               }
+           } while (kid);
+           if (!kid)
+               kid = cLISTOPo->op_last;
+last:
+           return search_const(kid);
+       }
+    }
+
+    return NULL;
+}
+
+STATIC OP *
 S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 {
     dVAR;
     LOGOP *logop;
     OP *o;
-    OP *first = *firstp;
-    OP * const other = *otherp;
+    OP *first;
+    OP *other;
+    OP *cstop = NULL;
+    int prepend_not = 0;
 
     PERL_ARGS_ASSERT_NEW_LOGOP;
 
+    first = *firstp;
+    other = *otherp;
+
     if (type == OP_XOR)                /* Not short circuit, but here by precedence. */
        return newBINOP(type, flags, scalar(first), scalar(other));
 
     scalarboolean(first);
-    /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
+    /* optimize AND and OR ops that have NOTs as children */
     if (first->op_type == OP_NOT
-       && (first->op_flags & OPf_SPECIAL)
        && (first->op_flags & OPf_KIDS)
+       && ((first->op_flags & OPf_SPECIAL) /* unless ($x) { } */
+           || (other->op_type == OP_NOT))  /* if (!$x && !$y) { } */
        && !PL_madskills) {
        if (type == OP_AND || type == OP_OR) {
            if (type == OP_AND)
                type = OP_OR;
            else
                type = OP_AND;
-           o = first;
-           first = *firstp = cUNOPo->op_first;
-           if (o->op_next)
-               first->op_next = o->op_next;
-           cUNOPo->op_first = NULL;
-           op_free(o);
+           op_null(first);
+           if (other->op_type == OP_NOT) { /* !a AND|OR !b => !(a OR|AND b) */
+               op_null(other);
+               prepend_not = 1; /* prepend a NOT op later */
+           }
        }
     }
-    if (first->op_type == OP_CONST) {
-       if (first->op_private & OPpCONST_STRICT)
-           no_bareword_allowed(first);
-       else if ((first->op_private & OPpCONST_BARE) && ckWARN(WARN_BAREWORD))
+    /* search for a constant op that could let us fold the test */
+    if ((cstop = search_const(first))) {
+       if (cstop->op_private & OPpCONST_STRICT)
+           no_bareword_allowed(cstop);
+       else if ((cstop->op_private & OPpCONST_BARE) && ckWARN(WARN_BAREWORD))
                Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
-       if ((type == OP_AND &&  SvTRUE(((SVOP*)first)->op_sv)) ||
-           (type == OP_OR  && !SvTRUE(((SVOP*)first)->op_sv)) ||
-           (type == OP_DOR && !SvOK(((SVOP*)first)->op_sv))) {
+       if ((type == OP_AND &&  SvTRUE(((SVOP*)cstop)->op_sv)) ||
+           (type == OP_OR  && !SvTRUE(((SVOP*)cstop)->op_sv)) ||
+           (type == OP_DOR && !SvOK(((SVOP*)cstop)->op_sv))) {
            *firstp = NULL;
            if (other->op_type == OP_CONST)
                other->op_private |= OPpCONST_SHORTCIRCUIT;
@@ -4582,7 +4645,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 
     CHECKOP(type,logop);
 
-    o = newUNOP(OP_NULL, 0, (OP*)logop);
+    o = newUNOP(prepend_not ? OP_NOT : OP_NULL, 0, (OP*)logop);
     other->op_next = o;
 
     return o;
@@ -4595,6 +4658,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
     LOGOP *logop;
     OP *start;
     OP *o;
+    OP *cstop;
 
     PERL_ARGS_ASSERT_NEWCONDOP;
 
@@ -4604,14 +4668,14 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
        return newLOGOP(OP_OR, 0, first, falseop);
 
     scalarboolean(first);
-    if (first->op_type == OP_CONST) {
+    if ((cstop = search_const(first))) {
        /* Left or right arm of the conditional?  */
-       const bool left = SvTRUE(((SVOP*)first)->op_sv);
+       const bool left = SvTRUE(((SVOP*)cstop)->op_sv);
        OP *live = left ? trueop : falseop;
        OP *const dead = left ? falseop : trueop;
-        if (first->op_private & OPpCONST_BARE &&
-           first->op_private & OPpCONST_STRICT) {
-           no_bareword_allowed(first);
+        if (cstop->op_private & OPpCONST_BARE &&
+           cstop->op_private & OPpCONST_STRICT) {
+           no_bareword_allowed(cstop);
        }
        if (PL_madskills) {
            /* This is all dead code when PERL_MAD is not defined.  */