X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=d50660d36e55abea5d099f8f149f562bd95a08cb;hb=4a9e32d883a2352f4baeab6cfa9a5ebeadedb121;hp=60c1b77a225fa1a5ecbb876c5ef4024608e2b394;hpb=f6f3a1fea2bda9d33f9cc5367b630a21738c9def;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 60c1b77..d50660d 100644
--- 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:
@@ -2521,7 +2535,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     case 3:
 	/* Something tried to die.  Abandon constant folding.  */
 	/* Pretend the error never happened.  */
-	sv_setpvn(ERRSV,"",0);
+	CLEAR_ERRSV();
 	o->op_next = old_next;
 	break;
     default:
@@ -4442,7 +4456,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     LOGOP *logop;
     OP *o;
     OP *first = *firstp;
-    OP * const other = *otherp;
+    OP *other = *otherp;
+    int prepend_not = 0;
 
     PERL_ARGS_ASSERT_NEW_LOGOP;
 
@@ -4450,22 +4465,22 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	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) {
@@ -4582,7 +4597,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;
@@ -6556,7 +6571,7 @@ Perl_ck_exists(pTHX_ OP *o)
 	else if (kid->op_type == OP_AELEM)
 	    o->op_flags |= OPf_SPECIAL;
 	else if (kid->op_type != OP_HELEM)
-	    Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
+	    Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or a subroutine",
 		        OP_DESC(o));
 	op_null(kid);
     }
@@ -7415,7 +7430,9 @@ Perl_ck_open(pTHX_ OP *o)
     if (table) {
 	SV **svp = hv_fetchs(table, "open_IN", FALSE);
 	if (svp && *svp) {
-	    const I32 mode = mode_from_discipline(*svp);
+	    STRLEN len = 0;
+	    const char *d = SvPV_const(*svp, len);
+	    const I32 mode = mode_from_discipline(d, len);
 	    if (mode & O_BINARY)
 		o->op_private |= OPpOPEN_IN_RAW;
 	    else if (mode & O_TEXT)
@@ -7424,7 +7441,9 @@ Perl_ck_open(pTHX_ OP *o)
 
 	svp = hv_fetchs(table, "open_OUT", FALSE);
 	if (svp && *svp) {
-	    const I32 mode = mode_from_discipline(*svp);
+	    STRLEN len = 0;
+	    const char *d = SvPV_const(*svp, len);
+	    const I32 mode = mode_from_discipline(d, len);
 	    if (mode & O_BINARY)
 		o->op_private |= OPpOPEN_OUT_RAW;
 	    else if (mode & O_TEXT)