revert "revert perl -h changes"

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 93d78c9..76eb16f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -409,8 +409,8 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
     /* allocate a spare slot and store the name in that slot */
 
     off = pad_add_name(name, len,
-                      is_our ? pad_add_OUR :
-                      PL_parser->in_my == KEY_state ? pad_add_STATE : 0,
+                      is_our ? padadd_OUR :
+                      PL_parser->in_my == KEY_state ? padadd_STATE : 0,
                    PL_parser->in_my_stash,
                    (is_our
                        /* $_ is always in main::, even with our */
@@ -562,6 +562,7 @@ Perl_op_clear(pTHX_ OP *o)
            o->op_targ = 0;
            goto retry;
        }
+    case OP_ENTERTRY:
     case OP_ENTEREVAL: /* Was holding hints. */
        o->op_targ = 0;
        break;
@@ -985,7 +986,7 @@ Perl_scalarvoid(pTHX_ OP *o)
     want = o->op_flags & OPf_WANT;
     if ((want && want != OPf_WANT_SCALAR)
         || (PL_parser && PL_parser->error_count)
-        || o->op_type == OP_RETURN)
+        || o->op_type == OP_RETURN || o->op_type == OP_REQUIRE)
     {
        return o;
     }
@@ -1086,6 +1087,17 @@ Perl_scalarvoid(pTHX_ OP *o)
            useless = OP_DESC(o);
        break;
 
+    case OP_SPLIT:
+       kid = cLISTOPo->op_first;
+       if (kid && kid->op_type == OP_PUSHRE
+#ifdef USE_ITHREADS
+               && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff)
+#else
+               && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv)
+#endif
+           useless = OP_DESC(o);
+       break;
+
     case OP_NOT:
        kid = cUNOPo->op_first;
        if (kid->op_type != OP_MATCH && kid->op_type != OP_SUBST &&
@@ -1215,10 +1227,6 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_ENTEREVAL:
        scalarkids(o);
        break;
-    case OP_REQUIRE:
-       /* all requires must return a boolean value */
-       o->op_flags &= ~OPf_WANT;
-       /* FALL THROUGH */
     case OP_SCALAR:
        return scalar(o);
     }
@@ -1307,10 +1315,6 @@ Perl_list(pTHX_ OP *o)
        }
        PL_curcop = &PL_compiling;
        break;
-    case OP_REQUIRE:
-       /* all requires must return a boolean value */
-       o->op_flags &= ~OPf_WANT;
-       return scalar(o);
     }
     return o;
 }
@@ -3020,6 +3024,8 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     dVAR;
     LISTOP *listop;
 
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LISTOP);
+
     NewOp(1101, listop, 1, LISTOP);
 
     listop->op_type = (OPCODE)type;
@@ -3053,6 +3059,12 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
 {
     dVAR;
     OP *o;
+
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+
     NewOp(1101, o, 1, OP);
     o->op_type = (OPCODE)type;
     o->op_ppaddr = PL_ppaddr[type];
@@ -3076,6 +3088,14 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
     dVAR;
     UNOP *unop;
 
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP
+       || type == OP_SASSIGN
+       || type == OP_ENTERTRY
+       || type == OP_NULL );
+
     if (!first)
        first = newOP(OP_STUB, 0);
     if (PL_opargs[type] & OA_MARK)
@@ -3099,6 +3119,10 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 {
     dVAR;
     BINOP *binop;
+
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
+       || type == OP_SASSIGN || type == OP_NULL );
+
     NewOp(1101, binop, 1, BINOP);
 
     if (!first)
@@ -3494,6 +3518,8 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
     dVAR;
     PMOP *pmop;
 
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PMOP);
+
     NewOp(1101, pmop, 1, PMOP);
     pmop->op_type = (OPCODE)type;
     pmop->op_ppaddr = PL_ppaddr[type];
@@ -3738,6 +3764,10 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
 
     PERL_ARGS_ASSERT_NEWSVOP;
 
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_SVOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP);
+
     NewOp(1101, svop, 1, SVOP);
     svop->op_type = (OPCODE)type;
     svop->op_ppaddr = PL_ppaddr[type];
@@ -3760,6 +3790,10 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
 
     PERL_ARGS_ASSERT_NEWPADOP;
 
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_SVOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP);
+
     NewOp(1101, padop, 1, PADOP);
     padop->op_type = (OPCODE)type;
     padop->op_ppaddr = PL_ppaddr[type];
@@ -3798,6 +3832,10 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
 {
     dVAR;
     PVOP *pvop;
+
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+       || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+
     NewOp(1101, pvop, 1, PVOP);
     pvop->op_type = (OPCODE)type;
     pvop->op_ppaddr = PL_ppaddr[type];
@@ -4241,7 +4279,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                    || left->op_type == OP_PADHV
                    || left->op_type == OP_PADANY))
        {
-           maybe_common_vars = FALSE;
+           if (left->op_type == OP_PADSV) maybe_common_vars = FALSE;
            if (left->op_private & OPpPAD_STATE) {
                /* All single variable list context state assignments, hence
                   state ($a) = ...
@@ -4555,6 +4593,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     if (type == OP_XOR)                /* Not short circuit, but here by precedence. */
        return newBINOP(type, flags, scalar(first), scalar(other));
 
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOGOP);
+
     scalarboolean(first);
     /* optimize AND and OR ops that have NOTs as children */
     if (first->op_type == OP_NOT
@@ -5111,6 +5151,8 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 
     PERL_ARGS_ASSERT_NEWLOOPEX;
 
+    assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+
     if (type != OP_GOTO || label->op_type == OP_CONST) {
        /* "last()" means "last" */
        if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
@@ -5240,14 +5282,11 @@ S_looks_like_bool(pTHX_ const OP *o)
             && looks_like_bool(cLOGOPo->op_first->op_sibling));
 
        case OP_NULL:
+       case OP_SCALAR:
            return (
                o->op_flags & OPf_KIDS
            && looks_like_bool(cUNOPo->op_first));
 
-        case OP_SCALAR:
-            return looks_like_bool(cUNOPo->op_first);
-
-
        case OP_ENTERSUB:
 
        case OP_NOT:    case OP_XOR:
@@ -5673,7 +5712,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                 )&& !attrs) {
                if (CvFLAGS(PL_compcv)) {
                    /* might have had built-in attrs applied */
-                   CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
+                   if (CvLVALUE(PL_compcv) && ! CvLVALUE(cv) && ckWARN(WARN_MISC))
+                       Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
+                   CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS & ~CVf_LVALUE);
                }
                /* just a "sub foo;" when &foo is already defined */
                SAVEFREESV(PL_compcv);
@@ -5742,8 +5783,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                   && block->op_type != OP_NULL
 #endif
        ) {
+           cv_flags_t existing_builtin_attrs = CvFLAGS(cv) & CVf_BUILTIN_ATTRS;
            cv_undef(cv);
-           CvFLAGS(cv) = CvFLAGS(PL_compcv);
+           CvFLAGS(cv) = CvFLAGS(PL_compcv) | existing_builtin_attrs;
            if (!CvWEAKOUTSIDE(cv))
                SvREFCNT_dec(CvOUTSIDE(cv));
            CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
@@ -6560,8 +6602,6 @@ Perl_ck_eval(pTHX_ OP *o)
            /* establish postfix order */
            enter->op_next = (OP*)enter;
 
-           CHECKOP(OP_ENTERTRY, enter);
-
            o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
            o->op_type = OP_LEAVETRY;
            o->op_ppaddr = PL_ppaddr[OP_LEAVETRY];
@@ -7170,10 +7210,10 @@ Perl_ck_grep(pTHX_ OP *o)
     if (o->op_flags & OPf_STACKED) {
        OP* k;
        o = ck_sort(o);
-        kid = cLISTOPo->op_first->op_sibling;
-       if (!cUNOPx(kid)->op_next)
-           Perl_croak(aTHX_ "panic: ck_grep");
-       for (k = cUNOPx(kid)->op_first; k; k = k->op_next) {
+        kid = cUNOPx(cLISTOPo->op_first->op_sibling)->op_first;
+       if (kid->op_type != OP_SCOPE && kid->op_type != OP_LEAVE)
+           return no_fh_allowed(o);
+       for (k = kid; k; k = k->op_next) {
            kid = k;
        }
        NewOp(1101, gwop, 1, LOGOP);
@@ -7640,7 +7680,7 @@ Perl_ck_require(pTHX_ OP *o)
        return newop;
     }
 
-    return ck_fun(o);
+    return scalar(ck_fun(o));
 }
 
 OP *
@@ -8325,8 +8365,9 @@ Perl_ck_each(pTHX_ OP *o)
 
 /* caller is supposed to assign the return to the 
    container of the rep_op var */
-OP *
+STATIC OP *
 S_opt_scalarhv(pTHX_ OP *rep_op) {
+    dVAR;
     UNOP *unop;
 
     PERL_ARGS_ASSERT_OPT_SCALARHV;
@@ -8354,7 +8395,7 @@ S_opt_scalarhv(pTHX_ OP *rep_op) {
  * beginning of the right-hand side. Returns the left-hand side of the
  * assignment if o acts in-place, or NULL otherwise. */
 
-OP *
+STATIC OP *
 S_is_inplace_av(pTHX_ OP *o, OP *oright) {
     OP *o2;
     OP *oleft = NULL;
@@ -8637,7 +8678,7 @@ Perl_peep(pTHX_ register OP *o)
             ){ 
                 OP * nop = o;
                 OP * lop = o;
-                if (!(nop->op_flags && OPf_WANT_VOID)) {
+                if (!((nop->op_flags & OPf_WANT) == OPf_WANT_VOID)) {
                     while (nop && nop->op_next) {
                         switch (nop->op_next->op_type) {
                             case OP_NOT:
@@ -8655,7 +8696,7 @@ Perl_peep(pTHX_ register OP *o)
                         }
                     }            
                 }
-                if (lop->op_flags && OPf_WANT_VOID) {
+                if ((lop->op_flags & OPf_WANT) == OPf_WANT_VOID) {
                     if (fop->op_type == OP_PADHV || fop->op_type == OP_RV2HV) 
                         cLOGOP->op_first = opt_scalarhv(fop);
                     if (sop && (sop->op_type == OP_PADHV || sop->op_type == OP_RV2HV))