define and use STATIC_ASSERT_STMT for compile-time invariants

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 2903d1f..6d575f7 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -752,7 +752,7 @@ PP(pp_trans)
 
     if (PL_op->op_flags & OPf_STACKED)
        sv = POPs;
-    else if (PL_op->op_private & OPpTARGET_MY)
+    else if (ARGTARG)
        sv = GETTARGET;
     else {
        sv = DEFSV;
@@ -774,16 +774,17 @@ PP(pp_trans)
 
 /* Lvalue operators. */
 
-static void
+static size_t
 S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 {
     STRLEN len;
     char *s;
+    size_t count = 0;
 
     PERL_ARGS_ASSERT_DO_CHOMP;
 
     if (chomping && (RsSNARF(PL_rs) || RsRECORD(PL_rs)))
-       return;
+       return 0;
     if (SvTYPE(sv) == SVt_PVAV) {
        I32 i;
        AV *const av = MUTABLE_AV(sv);
@@ -792,33 +793,30 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
        for (i = 0; i <= max; i++) {
            sv = MUTABLE_SV(av_fetch(av, i, FALSE));
            if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
-               do_chomp(retval, sv, chomping);
+               count += do_chomp(retval, sv, chomping);
        }
-        return;
+        return count;
     }
     else if (SvTYPE(sv) == SVt_PVHV) {
        HV* const hv = MUTABLE_HV(sv);
        HE* entry;
         (void)hv_iterinit(hv);
         while ((entry = hv_iternext(hv)))
-            do_chomp(retval, hv_iterval(hv,entry), chomping);
-       return;
+            count += do_chomp(retval, hv_iterval(hv,entry), chomping);
+       return count;
     }
     else if (SvREADONLY(sv)) {
             Perl_croak_no_modify();
     }
-    else if (SvIsCOW(sv)) {
-       sv_force_normal_flags(sv, 0);
-    }
 
-    if (PL_encoding) {
+    if (IN_ENCODING) {
        if (!SvUTF8(sv)) {
            /* XXX, here sv is utf8-ized as a side-effect!
               If encoding.pm is used properly, almost string-generating
               operations, including literal strings, chr(), input data, etc.
               should have been utf8-ized already, right?
            */
-           sv_recode_to_utf8(sv, PL_encoding);
+           sv_recode_to_utf8(sv, _get_encoding());
        }
     }
 
@@ -832,11 +830,11 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
            if (RsPARA(PL_rs)) {
                if (*s != '\n')
                    goto nope;
-               ++SvIVX(retval);
+               ++count;
                while (len && s[-1] == '\n') {
                    --len;
                    --s;
-                   ++SvIVX(retval);
+                   ++count;
                }
            }
            else {
@@ -863,11 +861,11 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
                        }
                        rsptr = temp_buffer;
                    }
-                   else if (PL_encoding) {
+                   else if (IN_ENCODING) {
                        /* RS is 8 bit, encoding.pm is used.
                         * Do not recode PL_rs as a side-effect. */
                        svrecode = newSVpvn(rsptr, rslen);
-                       sv_recode_to_utf8(svrecode, PL_encoding);
+                       sv_recode_to_utf8(svrecode, _get_encoding());
                        rsptr = SvPV_const(svrecode, rslen);
                        rs_charlen = sv_len_utf8(svrecode);
                    }
@@ -880,7 +878,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
                if (rslen == 1) {
                    if (*s != *rsptr)
                        goto nope;
-                   ++SvIVX(retval);
+                   ++count;
                }
                else {
                    if (len < rslen - 1)
@@ -889,10 +887,10 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
                    s -= rslen - 1;
                    if (memNE(s, rsptr, rslen))
                        goto nope;
-                   SvIVX(retval) += rs_charlen;
+                   count += rs_charlen;
                }
            }
-           s = SvPV_force_nomg_nolen(sv);
+           SvPV_force_nomg_nolen(sv);
            SvCUR_set(sv, len);
            *SvEND(sv) = '\0';
            SvNIOK_off(sv);
@@ -904,7 +902,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 
        Safefree(temp_buffer);
     } else {
-       if (len && !SvPOK(sv))
+       if (len && (!SvPOK(sv) || SvIsCOW(sv)))
            s = SvPV_force_nomg(sv, len);
        if (DO_UTF8(sv)) {
            if (s && len) {
@@ -936,6 +934,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
            sv_setpvs(retval, "");
        SvSETMAGIC(sv);
     }
+    return count;
 }
 
 
@@ -946,9 +945,9 @@ PP(pp_schop)
     dSP; dTARGET;
     const bool chomping = PL_op->op_type == OP_SCHOMP;
 
+    const size_t count = do_chomp(TARG, TOPs, chomping);
     if (chomping)
-       sv_setiv(TARG, 0);
-    do_chomp(TARG, TOPs, chomping);
+       sv_setiv(TARG, count);
     SETTARG;
     RETURN;
 }
@@ -960,11 +959,12 @@ PP(pp_chop)
 {
     dSP; dMARK; dTARGET; dORIGMARK;
     const bool chomping = PL_op->op_type == OP_CHOMP;
+    size_t count = 0;
 
-    if (chomping)
-       sv_setiv(TARG, 0);
     while (MARK < SP)
-       do_chomp(TARG, *++MARK, chomping);
+       count += do_chomp(TARG, *++MARK, chomping);
+    if (chomping)
+       sv_setiv(TARG, count);
     SP = ORIGMARK;
     XPUSHTARG;
     RETURN;
@@ -1080,7 +1080,7 @@ PP(pp_postinc)
        PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC;
     if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
        Perl_croak_no_modify();
-    if (!(PL_op->op_private & OPpTARGET_MY) && SvROK(TOPs))
+    if (SvROK(TOPs))
        TARG = sv_newmortal();
     sv_setsv(TARG, TOPs);
     if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
@@ -2051,7 +2051,7 @@ Perl_do_ncmp(pTHX_ SV* const left, SV * const right)
                    return (leftuv > (UV)rightiv) - (leftuv < (UV)rightiv);
                }
            }
-           assert(0); /* NOTREACHED */
+           NOT_REACHED; /* NOTREACHED */
     }
 #endif
     {
@@ -2956,7 +2956,7 @@ PP(pp_length)
     /* simplest case shortcut */
     /* turn off SVf_UTF8 in tmp flags if HINT_BYTES on*/
     U32 svflags = (SvFLAGS(sv) ^ (in_bytes << 26)) & (SVf_POK|SVs_GMG|SVf_UTF8);
-    assert(HINT_BYTES == 0x00000008 && SVf_UTF8 == 0x20000000 && (SVf_UTF8 == HINT_BYTES << 26));
+    STATIC_ASSERT_STMT(HINT_BYTES == 0x00000008 && SVf_UTF8 == 0x20000000 && (SVf_UTF8 == HINT_BYTES << 26));
     SETs(TARG);
 
     if(LIKELY(svflags == SVf_POK))
@@ -3225,6 +3225,8 @@ PP(pp_vec)
     }
 
     sv_setuv(ret, do_vecget(src, offset, size));
+    if (!lvalue)
+       SvSETMAGIC(ret);
     PUSHs(ret);
     RETURN;
 }
@@ -3260,7 +3262,7 @@ PP(pp_index)
     little_utf8 = DO_UTF8(little);
     if (big_utf8 ^ little_utf8) {
        /* One needs to be upgraded.  */
-       if (little_utf8 && !PL_encoding) {
+       if (little_utf8 && !IN_ENCODING) {
            /* Well, maybe instead we might be able to downgrade the small
               string?  */
            char * const pv = (char*)bytes_from_utf8((U8 *)little_p, &llen,
@@ -3282,8 +3284,8 @@ PP(pp_index)
            temp = little_utf8
                ? newSVpvn(big_p, biglen) : newSVpvn(little_p, llen);
 
-           if (PL_encoding) {
-               sv_recode_to_utf8(temp, PL_encoding);
+           if (IN_ENCODING) {
+               sv_recode_to_utf8(temp, _get_encoding());
            } else {
                sv_utf8_upgrade(temp);
            }
@@ -3368,9 +3370,9 @@ PP(pp_ord)
     STRLEN len;
     const U8 *s = (U8*)SvPV_const(argsv, len);
 
-    if (PL_encoding && SvPOK(argsv) && !DO_UTF8(argsv)) {
+    if (IN_ENCODING && SvPOK(argsv) && !DO_UTF8(argsv)) {
         SV * const tmpsv = sv_2mortal(newSVsv(argsv));
-        s = (U8*)sv_recode_to_utf8(tmpsv, PL_encoding);
+        s = (U8*)sv_recode_to_utf8(tmpsv, _get_encoding());
         len = UTF8SKIP(s);  /* Should be well-formed; so this is its length */
         argsv = tmpsv;
     }
@@ -3422,7 +3424,7 @@ PP(pp_chr)
        *tmps = '\0';
        (void)SvPOK_only(TARG);
        SvUTF8_on(TARG);
-       XPUSHs(TARG);
+       XPUSHTARG;
        RETURN;
     }
 
@@ -3433,8 +3435,8 @@ PP(pp_chr)
     *tmps = '\0';
     (void)SvPOK_only(TARG);
 
-    if (PL_encoding && !IN_BYTES) {
-        sv_recode_to_utf8(TARG, PL_encoding);
+    if (IN_ENCODING && !IN_BYTES) {
+        sv_recode_to_utf8(TARG, _get_encoding());
        tmps = SvPVX(TARG);
        if (SvCUR(TARG) == 0
            || ! is_utf8_string((U8*)tmps, SvCUR(TARG))
@@ -3449,7 +3451,7 @@ PP(pp_chr)
        }
     }
 
-    XPUSHs(TARG);
+    XPUSHTARG;
     RETURN;
 }
 
@@ -3465,9 +3467,8 @@ PP(pp_crypt)
          /* If Unicode, try to downgrade.
          * If not possible, croak.
          * Yes, we made this up.  */
-        SV* const tsv = sv_2mortal(newSVsv(left));
+        SV* const tsv = newSVpvn_flags(tmps, len, SVf_UTF8|SVs_TEMP);
 
-        SvUTF8_on(tsv);
         sv_utf8_downgrade(tsv, FALSE);
         tmps = SvPV_const(tsv, len);
     }
@@ -3494,6 +3495,7 @@ PP(pp_crypt)
 #   else
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right)));
 #   endif
+    SvUTF8_off(TARG);
     SETTARG;
     RETURN;
 #else
@@ -6227,9 +6229,10 @@ PP(pp_refassign)
     if (bad)
        /* diag_listed_as: Assigned value is not %s reference */
        DIE(aTHX_ "Assigned value is not a%s reference", bad);
+    {
+    MAGIC *mg;
+    HV *stash;
     switch (left ? SvTYPE(left) : 0) {
-       MAGIC *mg;
-       HV *stash;
     case 0:
     {
        SV * const old = PAD_SV(ARGTARG);
@@ -6258,13 +6261,14 @@ PP(pp_refassign)
        if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO))
            S_localise_helem_lval(aTHX_ (HV *)left, key,
                                        SvCANEXISTDELETE(left));
-       hv_store_ent((HV *)left, key, SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
+       (void)hv_store_ent((HV *)left, key, SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
     }
     if (PL_op->op_flags & OPf_MOD)
        SETs(sv_2mortal(newSVsv(sv)));
     /* XXX else can weak references go stale before they are read, e.g.,
        in leavesub?  */
     RETURN;
+    }
 }
 
 PP(pp_lvref)