Revert "Remove some deprecated functions from mathoms.c"

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 7f4618b..ddeb484 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1223,8 +1223,7 @@ S_cop_free(pTHX_ COP* cop)
 }
 
 STATIC void
-S_forget_pmop(pTHX_ PMOP *const o
-             )
+S_forget_pmop(pTHX_ PMOP *const o)
 {
     HV * const pmstash = PmopSTASH(o);
 
@@ -3204,16 +3203,16 @@ S_maybe_multiconcat(pTHX_ OP *o)
             OP *prev;
 
             /* set prev to the sibling *before* the arg to be cut out,
-             * e.g.:
+             * e.g. when cutting EXPR:
              *
              *         |
-             * kid=  CONST
+             * kid=  CONCAT
              *         |
-             * prev= CONST -- EXPR
+             * prev= CONCAT -- EXPR
              *         |
              */
             if (argp == args && kid->op_type != OP_CONCAT) {
-                /* in e.g. '$x . = f(1)' there's no RHS concat tree
+                /* in e.g. '$x .= f(1)' there's no RHS concat tree
                  * so the expression to be cut isn't kid->op_last but
                  * kid itself */
                 OP *o1, *o2;
@@ -4081,7 +4080,10 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
     case OP_RV2HV:
        if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
            PL_modcount = RETURN_UNLIMITED_NUMBER;
-           return o;           /* Treat \(@foo) like ordinary list. */
+           /* Treat \(@foo) like ordinary list, but still mark it as modi-
+              fiable since some contexts need to know.  */
+           o->op_flags |= OPf_MOD;
+           return o;
        }
        /* FALLTHROUGH */
     case OP_RV2GV:
@@ -4146,7 +4148,12 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
     case OP_PADHV:
        PL_modcount = RETURN_UNLIMITED_NUMBER;
        if (type == OP_REFGEN && o->op_flags & OPf_PARENS)
-           return o;           /* Treat \(@foo) like ordinary list. */
+       {
+           /* Treat \(@foo) like ordinary list, but still mark it as modi-
+              fiable since some contexts need to know.  */
+           o->op_flags |= OPf_MOD;
+           return o;
+       }
        if (scalar_mod_type(o, type))
            goto nomod;
        if ((o->op_flags & OPf_WANT) != OPf_WANT_SCALAR
@@ -6340,15 +6347,14 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     STRLEN rlen;
     const U8 *t = (U8*)SvPV_const(tstr, tlen);
     const U8 *r = (U8*)SvPV_const(rstr, rlen);
-    I32 i;
-    I32 j;
-    I32 grows = 0;
+    Size_t i, j;
+    bool grows = FALSE;
     OPtrans_map *tbl;
     SSize_t struct_size; /* malloced size of table struct */
 
     const bool complement = cBOOL(o->op_private & OPpTRANS_COMPLEMENT);
-    const I32 squash     = o->op_private & OPpTRANS_SQUASH;
-    I32 del              = o->op_private & OPpTRANS_DELETE;
+    const bool squash     = cBOOL(o->op_private & OPpTRANS_SQUASH);
+    const bool del        = cBOOL(o->op_private & OPpTRANS_DELETE);
     SV* swash;
 
     PERL_ARGS_ASSERT_PMTRANS;
@@ -6573,7 +6579,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 
        none = ++max;
        if (del)
-           del = ++max;
+           ++max;
 
        if (max > 0xffff)
            bits = 32;
@@ -6641,17 +6647,17 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     cPVOPo->op_pv = (char*)tbl;
 
     if (complement) {
-        SSize_t excess;
+        Size_t excess;
 
         /* in this branch, j is a count of 'consumed' (i.e. paired off
          * with a search char) replacement chars (so j <= rlen always)
          */
-       for (i = 0; i < (I32)tlen; i++)
+       for (i = 0; i < tlen; i++)
            tbl->map[t[i]] = -1;
 
        for (i = 0, j = 0; i < 256; i++) {
            if (!tbl->map[i]) {
-               if (j == (I32)rlen) {
+               if (j == rlen) {
                    if (del)
                        tbl->map[i] = -2;
                    else if (rlen)
@@ -6666,12 +6672,12 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                     &&  UVCHR_IS_INVARIANT((UV)i)
                     && !UVCHR_IS_INVARIANT((UV)(tbl->map[i]))
                 )
-                    grows = 1;
+                    grows = TRUE;
            }
        }
 
-        assert(j <= (I32)rlen);
-        excess = rlen - (SSize_t)j;
+        ASSUME(j <= rlen);
+        excess = rlen - j;
 
         if (excess) {
             /* More replacement chars than search chars:
@@ -6684,7 +6690,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
             tbl->size += excess;
             cPVOPo->op_pv = (char*)tbl;
 
-            for (i = 0; i < (I32)excess; i++)
+            for (i = 0; i < excess; i++)
                 tbl->map[i + 256] = r[j+i];
         }
         else {
@@ -6707,8 +6713,8 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 
        for (i = 0; i < 256; i++)
            tbl->map[i] = -1;
-       for (i = 0, j = 0; i < (I32)tlen; i++,j++) {
-           if (j >= (I32)rlen) {
+       for (i = 0, j = 0; i < tlen; i++,j++) {
+           if (j >= rlen) {
                if (del) {
                    if (tbl->map[t[i]] == -1)
                        tbl->map[t[i]] = -2;
@@ -6719,7 +6725,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            if (tbl->map[t[i]] == -1) {
                 if (     UVCHR_IS_INVARIANT(t[i])
                     && ! UVCHR_IS_INVARIANT(r[j]))
-                   grows = 1;
+                   grows = TRUE;
                tbl->map[t[i]] = r[j];
            }
        }
@@ -6945,9 +6951,15 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
                op_null(scope);
            }
 
-           if (is_compiletime)
-               /* runtime finalizes as part of finalizing whole tree */
-                optimize_optree(o);
+            /* XXX optimize_optree() must be called on o before
+             * CALL_PEEP(), as currently S_maybe_multiconcat() can't
+             * currently cope with a peephole-optimised optree.
+             * Calling optimize_optree() here ensures that condition
+             * is met, but may mean optimize_optree() is applied
+             * to the same optree later (where hopefully it won't do any
+             * harm as it can't convert an op to multiconcat if it's
+             * already been converted */
+            optimize_optree(o);
 
            /* have to peep the DOs individually as we've removed it from
             * the op_next chain */
@@ -9060,6 +9072,13 @@ S_looks_like_bool(pTHX_ const OP *o)
        case OP_FLOP:
 
            return TRUE;
+
+       case OP_INDEX:
+       case OP_RINDEX:
+            /* optimised-away (index() != -1) or similar comparison */
+            if (o->op_private & OPpTRUEBOOL)
+                return TRUE;
+            return FALSE;
        
        case OP_CONST:
            /* Detect comparisons that have been optimized away */
@@ -9069,7 +9088,6 @@ S_looks_like_bool(pTHX_ const OP *o)
                return TRUE;
            else
                return FALSE;
-
        /* FALLTHROUGH */
        default:
            return FALSE;
@@ -9840,9 +9858,12 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
           Also, we may be called from load_module at run time, so
           PL_curstash (which sets CvSTASH) may not point to the stash the
           sub is stored in.  */
+       /* XXX This optimization is currently disabled for packages other
+              than main, since there was too much CPAN breakage.  */
        const I32 flags =
           ec ? GV_NOADD_NOINIT
              :   (IN_PERL_RUNTIME && PL_curstash != CopSTASH(PL_curcop))
+              || PL_curstash != PL_defstash
               || memchr(name, ':', namlen) || memchr(name, '\'', namlen)
                    ? gv_fetch_flags
                    : GV_ADDMULTI | GV_NOINIT | GV_NOTQUAL;