This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix C++ build broken by 1f039d60d3
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 52e600f..41bea3b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -819,6 +819,7 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_TRANS:
     case OP_TRANSR:
        if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
+           assert(o->op_type == OP_TRANS || o->op_type == OP_TRANSR);
 #ifdef USE_ITHREADS
            if (cPADOPo->op_padix > 0) {
                pad_swipe(cPADOPo->op_padix, TRUE);
@@ -6367,7 +6368,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
 Constructs, checks, and returns a loop-exiting op (such as C<goto>
 or C<last>).  I<type> is the opcode.  I<label> supplies the parameter
 determining the target of the op; it is consumed by this function and
-become part of the constructed op tree.
+becomes part of the constructed op tree.
 
 =cut
 */
@@ -6376,7 +6377,7 @@ OP*
 Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 {
     dVAR;
-    OP *o;
+    OP *o = NULL;
 
     PERL_ARGS_ASSERT_NEWLOOPEX;
 
@@ -6384,37 +6385,39 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 
     if (type != OP_GOTO) {
        /* "last()" means "last" */
-       if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
+       if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS)) {
            o = newOP(type, OPf_SPECIAL);
-       else {
-         const_label:
-           o = newPVOP(type,
-                        label->op_type == OP_CONST
-                            ? SvUTF8(((SVOP*)label)->op_sv)
-                            : 0,
-                        savesharedpv(label->op_type == OP_CONST
-                               ? SvPV_nolen_const(((SVOP*)label)->op_sv)
-                               : ""));
        }
-#ifdef PERL_MAD
-       op_getmad(label,o,'L');
-#else
-       op_free(label);
-#endif
     }
     else {
        /* Check whether it's going to be a goto &function */
        if (label->op_type == OP_ENTERSUB
                && !(label->op_flags & OPf_STACKED))
            label = newUNOP(OP_REFGEN, 0, op_lvalue(label, OP_REFGEN));
-       else if (label->op_type == OP_CONST) {
+    }
+
+    /* Check for a constant argument */
+    if (label->op_type == OP_CONST) {
            SV * const sv = ((SVOP *)label)->op_sv;
            STRLEN l;
            const char *s = SvPV_const(sv,l);
-           if (l == strlen(s)) goto const_label;
-       }
-       o = newUNOP(type, OPf_STACKED, label);
+           if (l == strlen(s)) {
+               o = newPVOP(type,
+                           SvUTF8(((SVOP*)label)->op_sv),
+                           savesharedpv(
+                               SvPV_nolen_const(((SVOP*)label)->op_sv)));
+           }
     }
+    
+    /* If we have already created an op, we do not need the label. */
+    if (o)
+#ifdef PERL_MAD
+               op_getmad(label,o,'L');
+#else
+               op_free(label);
+#endif
+    else o = newUNOP(type, OPf_STACKED, label);
+
     PL_hints |= HINT_BLOCK_SCOPE;
     return o;
 }
@@ -7038,10 +7041,11 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
            cv_flags_t existing_builtin_attrs = CvFLAGS(cv) & CVf_BUILTIN_ATTRS;
            AV *const temp_av = CvPADLIST(cv);
            CV *const temp_cv = CvOUTSIDE(cv);
-           const cv_flags_t slabbed = CvSLABBED(cv);
+           const cv_flags_t other_flags =
+               CvFLAGS(cv) & (CVf_SLABBED|CVf_WEAKOUTSIDE);
            OP * const cvstart = CvSTART(cv);
 
-           assert(!CvWEAKOUTSIDE(cv));
+           CvGV_set(cv,gv);
            assert(!CvCVGV_RC(cv));
            assert(CvGV(cv) == gv);
 
@@ -7054,8 +7058,8 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
            CvPADLIST(PL_compcv) = temp_av;
            CvSTART(cv) = CvSTART(PL_compcv);
            CvSTART(PL_compcv) = cvstart;
-           if (slabbed) CvSLABBED_on(PL_compcv);
-           else CvSLABBED_off(PL_compcv);
+           CvFLAGS(PL_compcv) &= ~(CVf_SLABBED|CVf_WEAKOUTSIDE);
+           CvFLAGS(PL_compcv) |= other_flags;
 
            if (CvFILE(cv) && CvDYNFILE(cv)) {
                Safefree(CvFILE(cv));
@@ -10031,7 +10035,8 @@ Perl_ck_trunc(pTHX_ OP *o)
        if (kid->op_type == OP_NULL)
            kid = (SVOP*)kid->op_sibling;
        if (kid && kid->op_type == OP_CONST &&
-           (kid->op_private & OPpCONST_BARE))
+           (kid->op_private & (OPpCONST_BARE|OPpCONST_FOLDED))
+                            == OPpCONST_BARE)
        {
            o->op_flags |= OPf_SPECIAL;
            kid->op_private &= ~OPpCONST_STRICT;