Some signals are more real than others

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 814b07d..ac1311d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -128,8 +128,8 @@ Perl_Slab_Alloc(pTHX_ int m, size_t sz)
 void
 Perl_Slab_Free(pTHX_ void *op)
 {
-    I32 **ptr = (I32 **) op;
-    I32 *slab = ptr[-1];
+    I32 ** const ptr = (I32 **) op;
+    I32 * const slab = ptr[-1];
     assert( ptr-1 > (I32 **) slab );
     assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
     assert( *slab > 0 );
@@ -161,7 +161,7 @@ Perl_Slab_Free(pTHX_ void *op)
 STATIC const char*
 S_gv_ename(pTHX_ GV *gv)
 {
-    SV* tmpsv = sv_newmortal();
+    SV* const tmpsv = sv_newmortal();
     gv_efullname3(tmpsv, gv, Nullch);
     return SvPV_nolen_const(tmpsv);
 }
@@ -1636,7 +1636,7 @@ Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv,
     while (len) {
         for (; isSPACE(*attrstr) && len; --len, ++attrstr) ;
         if (len) {
-            const char *sstr = attrstr;
+            const char * const sstr = attrstr;
             for (; !isSPACE(*attrstr) && len; --len, ++attrstr) ;
             attrs = append_elem(OP_LIST, attrs,
                                 newSVOP(OP_CONST, 0,
@@ -1767,11 +1767,12 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
     OP *o;
     bool ismatchop = 0;
 
-    if (ckWARN(WARN_MISC) &&
-      (left->op_type == OP_RV2AV ||
+    if ( (left->op_type == OP_RV2AV ||
        left->op_type == OP_RV2HV ||
        left->op_type == OP_PADAV ||
-       left->op_type == OP_PADHV)) {
+       left->op_type == OP_PADHV)
+       && ckWARN(WARN_MISC))
+    {
       const char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
                             right->op_type == OP_TRANS)
                            ? right->op_type : OP_MATCH];
@@ -1960,8 +1961,8 @@ Perl_localize(pTHX_ OP *o, I32 lex)
        ;
 #endif
     else {
-       if (ckWARN(WARN_PARENTHESIS)
-           && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
+       if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ','
+           && ckWARN(WARN_PARENTHESIS))
        {
            char *s = PL_bufptr;
            bool sigil = FALSE;
@@ -2441,7 +2442,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            U8 tmpbuf[UTF8_MAXBYTES+1];
            UV *cp;
            UV nextmin = 0;
-           New(1109, cp, 2*tlen, UV);
+           Newx(cp, 2*tlen, UV);
            i = 0;
            transv = newSVpvn("",0);
            while (t < tend) {
@@ -3026,10 +3027,10 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 
     veop = Nullop;
 
-    if (version != Nullop) {
+    if (version) {
        SV *vesv = ((SVOP*)version)->op_sv;
 
-       if (arg == Nullop && !SvNIOKp(vesv)) {
+       if (!arg && !SvNIOKp(vesv)) {
            arg = version;
        }
        else {
@@ -3274,14 +3275,15 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
        OP *curop;
 
        PL_modcount = 0;
-       PL_eval_start = right;  /* Grandfathering $[ assignment here.  Bletch.*/
+       /* Grandfathering $[ assignment here.  Bletch.*/
+       /* Only simple assignments like C<< ($[) = 1 >> are allowed */
+       PL_eval_start = (left->op_type == OP_CONST) ? right : 0;
        left = mod(left, OP_AASSIGN);
        if (PL_eval_start)
            PL_eval_start = 0;
-       else {
-           op_free(left);
-           op_free(right);
-           return Nullop;
+       else if (left->op_type == OP_CONST) {
+           /* Result of assignment is always 1 (or we'd be dead already) */
+           return newSVOP(OP_CONST, 0, newSViv(1));
        }
        /* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
        if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
@@ -3418,8 +3420,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
        if (PL_eval_start)
            PL_eval_start = 0;
        else {
-           op_free(o);
-           return Nullop;
+           o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
        }
     }
     return o;
@@ -3528,7 +3529,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     if (first->op_type == OP_CONST) {
        if (first->op_private & OPpCONST_STRICT)
            no_bareword_allowed(first);
-       else if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
+       else if ((first->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)) ||
@@ -3564,8 +3565,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            return first;
        }
     }
-    else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS) &&
-             type != OP_DOR) /* [#24076] Don't warn for <FH> err FOO. */
+    else if ((first->op_flags & OPf_KIDS) && type != OP_DOR
+       && ckWARN(WARN_MISC)) /* [#24076] Don't warn for <FH> err FOO. */
     {
        const OP *k1 = ((UNOP*)first)->op_first;
        const OP *k2 = k1->op_sibling;
@@ -3742,7 +3743,8 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
     OP* o;
     const bool once = block && block->op_flags & OPf_SPECIAL &&
       (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
-    (void)debuggable;
+
+    PERL_UNUSED_ARG(debuggable);
 
     if (expr) {
        if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
@@ -3752,8 +3754,8 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );
        } else if (expr->op_flags & OPf_KIDS) {
-            const OP *k1 = ((UNOP*)expr)->op_first;
-            const OP *k2 = (k1) ? k1->op_sibling : NULL;
+           const OP * const k1 = ((UNOP*)expr)->op_first;
+           const OP * const k2 = k1 ? k1->op_sibling : NULL;
            switch (expr->op_type) {
              case OP_NULL:
                if (k2 && k2->op_type == OP_READLINE
@@ -3805,15 +3807,16 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
     OP *listop;
     OP *o;
     U8 loopflags = 0;
-    (void)debuggable;
+
+    PERL_UNUSED_ARG(debuggable);
 
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
                 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
        expr = newUNOP(OP_DEFINED, 0,
            newASSIGNOP(0, newDEFSVOP(), 0, expr) );
     } else if (expr && (expr->op_flags & OPf_KIDS)) {
-       const OP *k1 = ((UNOP*)expr)->op_first;
-       const OP *k2 = (k1) ? k1->op_sibling : NULL;
+       const OP * const k1 = ((UNOP*)expr)->op_first;
+       const OP * const k2 = (k1) ? k1->op_sibling : NULL;
        switch (expr->op_type) {
          case OP_NULL:
            if (k2 && k2->op_type == OP_READLINE
@@ -4157,7 +4160,7 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
        o = cLISTOPo->op_first->op_sibling;
 
     for (; o; o = o->op_next) {
-       OPCODE type = o->op_type;
+       const OPCODE type = o->op_type;
 
        if (sv && o->op_next == o)
            return sv;
@@ -4204,7 +4207,8 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
 void
 Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
-    (void)floor;
+    PERL_UNUSED_ARG(floor);
+
     if (o)
        SAVEFREEOP(o);
     if (proto)
@@ -4244,7 +4248,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        ps = Nullch;
 
     if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) {
-       SV *sv = sv_newmortal();
+       SV * const sv = sv_newmortal();
        Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]",
                       PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
                       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
@@ -4626,7 +4630,7 @@ Used by C<xsubpp> to hook up XSUBs as Perl subs.
 CV *
 Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
 {
-    GV *gv = gv_fetchpv(name ? name :
+    GV * const gv = gv_fetchpv(name ? name :
                        (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
                        GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
@@ -4904,7 +4908,7 @@ Perl_oopsCV(pTHX_ OP *o)
 {
     Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
     /* STUB */
-    (void)o;
+    PERL_UNUSED_ARG(o);
     NORETURN_FUNCTION_END;
 }
 
@@ -5068,7 +5072,7 @@ Perl_ck_eval(pTHX_ OP *o)
     dVAR;
     PL_hints |= HINT_BLOCK_SCOPE;
     if (o->op_flags & OPf_KIDS) {
-       SVOP *kid = (SVOP*)cUNOPo->op_first;
+       SVOP * const kid = (SVOP*)cUNOPo->op_first;
 
        if (!kid) {
            o->op_flags &= ~OPf_KIDS;
@@ -5142,7 +5146,7 @@ Perl_ck_exists(pTHX_ OP *o)
 {
     o = ck_fun(o);
     if (o->op_flags & OPf_KIDS) {
-       OP *kid = cUNOPo->op_first;
+       OP * const kid = cUNOPo->op_first;
        if (kid->op_type == OP_ENTERSUB) {
            (void) ref(kid, o->op_type);
            if (kid->op_type != OP_RV2CV && !PL_error_count)
@@ -6188,7 +6192,7 @@ Perl_ck_split(pTHX_ OP *o)
     kid->op_type = OP_PUSHRE;
     kid->op_ppaddr = PL_ppaddr[OP_PUSHRE];
     scalar(kid);
-    if (ckWARN(WARN_REGEXP) && ((PMOP *)kid)->op_pmflags & PMf_GLOBAL) {
+    if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL && ckWARN(WARN_REGEXP)) {
       Perl_warner(aTHX_ packWARN(WARN_REGEXP),
                   "Use of /g modifier is meaningless in split");
     }
@@ -6214,9 +6218,9 @@ Perl_ck_split(pTHX_ OP *o)
 OP *
 Perl_ck_join(pTHX_ OP *o)
 {
-    if (ckWARN(WARN_SYNTAX)) {
-       const OP *kid = cLISTOPo->op_first->op_sibling;
-       if (kid && kid->op_type == OP_MATCH) {
+    const OP *kid = cLISTOPo->op_first->op_sibling;
+    if (kid && kid->op_type == OP_MATCH) {
+       if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
            const char *pmstr = re ? re->precomp : "STRING";
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
@@ -6267,7 +6271,7 @@ Perl_ck_subr(pTHX_ OP *o)
                    }
                    else {
                        delete_op = 1;
-                       if (ckWARN(WARN_ASSERTIONS) && !(PL_hints & HINT_ASSERTIONSSEEN)) {
+                       if (!(PL_hints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) {
                            Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
                                        "Impossible to activate assertion call");
                        }
@@ -6739,8 +6743,9 @@ Perl_peep(pTHX_ register OP *o)
 
        case OP_EXEC:
            o->op_opt = 1;
-           if (ckWARN(WARN_SYNTAX) && o->op_next
-               && o->op_next->op_type == OP_NEXTSTATE) {
+           if (o->op_next && o->op_next->op_type == OP_NEXTSTATE
+               && ckWARN(WARN_SYNTAX))
+           {
                if (o->op_next->op_sibling &&
                        o->op_next->op_sibling->op_type != OP_EXIT &&
                        o->op_next->op_sibling->op_type != OP_WARN &&