This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
S_already_defined no longer uses its gv parameter, remove it
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 09af08a..a57309b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2979,8 +2979,10 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
     /* !~ doesn't make sense with /r, so error on it for now */
     if (rtype == OP_SUBST && (cPMOPx(right)->op_pmflags & PMf_NONDESTRUCT) &&
        type == OP_NOT)
+       /* diag_listed_as: Using !~ with %s doesn't make sense */
        yyerror("Using !~ with s///r doesn't make sense");
     if (rtype == OP_TRANSR && type == OP_NOT)
+       /* diag_listed_as: Using !~ with %s doesn't make sense */
        yyerror("Using !~ with tr///r doesn't make sense");
 
     ismatchop = (rtype == OP_MATCH ||
@@ -7197,8 +7199,7 @@ Perl_op_const_sv(pTHX_ const OP *o)
 
 static bool
 S_already_defined(pTHX_ CV *const cv, OP * const block, OP * const o,
-                       PADNAME * const name, SV ** const const_svp,
-                       GV * const gv)
+                       PADNAME * const name, SV ** const const_svp)
 {
     assert (cv);
     assert (o || name);
@@ -7249,8 +7250,7 @@ S_already_defined(pTHX_ CV *const cv, OP * const block, OP * const o,
 #endif
     {
        /* (PL_madskills unset in used file.) */
-       if (gv) GvCV_set(gv,NULL);
-       SvREFCNT_dec(cv);
+       SAVEFREESV(cv);
     }
     return TRUE;
 }
@@ -7374,7 +7374,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
             cv_ckproto_len_flags(cv, (GV *)name, ps, ps_len, ps_utf8);
        /* already defined? */
        if (exists) {
-           if (S_already_defined(aTHX_ cv,block,NULL,name,&const_sv,NULL))
+           if (S_already_defined(aTHX_ cv,block,NULL,name,&const_sv))
                cv = NULL;
            else {
                if (attrs) goto attrs;
@@ -7746,7 +7746,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
             cv_ckproto_len_flags(cv, gv, ps, ps_len, ps_utf8);
        /* already defined (or promised)? */
        if (exists || GvASSUMECV(gv)) {
-           if (S_already_defined(aTHX_ cv, block, o, NULL, &const_sv, gv))
+           if (S_already_defined(aTHX_ cv, block, o, NULL, &const_sv))
                cv = NULL;
            else {
                if (attrs) goto attrs;
@@ -8115,6 +8115,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
                           U32 flags)
 {
     CV *cv;
+    bool interleave = FALSE;
 
     PERL_ARGS_ASSERT_NEWXS_LEN_FLAGS;
 
@@ -8144,8 +8145,9 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
                                         ),
                                         cv, const_svp);
                 }
-                GvCV_set(gv,NULL);
-                SvREFCNT_dec_NN(cv);
+                interleave = TRUE;
+                ENTER;
+                SAVEFREESV(cv);
                 cv = NULL;
             }
         }
@@ -8180,6 +8182,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
        CvDYNFILE_on(cv);
     }
     sv_setpv(MUTABLE_SV(cv), proto);
+    if (interleave) LEAVE;
     return cv;
 }
 
@@ -11058,6 +11061,9 @@ S_inplace_aassign(pTHX_ OP *o) {
     defer_queue[(defer_base + ++defer_ix) % MAX_DEFERRED] = o; \
   } STMT_END
 
+#define IS_AND_OP(o)   (o->op_type == OP_AND)
+#define IS_OR_OP(o)    (o->op_type == OP_OR)
+
 /* A peephole optimizer.  We visit the ops in the order they're to execute.
  * See the comments at the top of this file for more details about when
  * peep() is called */
@@ -11525,6 +11531,21 @@ Perl_rpeep(pTHX_ OP *o)
            while (o->op_next && (   o->op_type == o->op_next->op_type
                                  || o->op_next->op_type == OP_NULL))
                o->op_next = o->op_next->op_next;
+
+           /* if we're an OR and our next is a AND in void context, we'll
+              follow it's op_other on short circuit, same for reverse.
+              We can't do this with OP_DOR since if it's true, its return
+              value is the underlying value which must be evaluated
+              by the next op */
+           if (o->op_next &&
+               (
+                   (IS_AND_OP(o) && IS_OR_OP(o->op_next))
+                || (IS_OR_OP(o) && IS_AND_OP(o->op_next))
+               )
+               && (o->op_next->op_flags & OPf_WANT) == OPf_WANT_VOID
+           ) {
+               o->op_next = ((LOGOP*)o->op_next)->op_other;
+           }
            DEFER(cLOGOP->op_other);
           
            o->op_opt = 1;