Extract _DB__handle_watch_expressions() .

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 24837a0..6088a11 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -84,6 +84,7 @@ PP(pp_padav)
     }
     gimme = GIMME_V;
     if (gimme == G_ARRAY) {
+        /* XXX see also S_pushav in pp_hot.c */
        const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1;
        EXTEND(SP, maxarg);
        if (SvMAGICAL(TARG)) {
@@ -230,7 +231,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
                if (vivify_sv && sv != &PL_sv_undef) {
                    GV *gv;
                    if (SvREADONLY(sv))
-                       Perl_croak_no_modify(aTHX);
+                       Perl_croak_no_modify();
                    if (cUNOP->op_targ) {
                        SV * const namesv = PAD_SV(cUNOP->op_targ);
                        gv = MUTABLE_GV(newSV(0));
@@ -776,7 +777,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
            sv_force_normal_flags(sv, 0);
         }
         else
-            Perl_croak_no_modify(aTHX);
+            Perl_croak_no_modify();
     }
 
     if (PL_encoding) {
@@ -980,11 +981,9 @@ PP(pp_undef)
        }
        break;
     case SVt_PVGV:
-       if (SvFAKE(sv)) {
-           SvSetMagicSV(sv, &PL_sv_undef);
-           break;
-       }
-       else if (isGV_with_GP(sv)) {
+       assert(isGV_with_GP(sv));
+       assert(!SvFAKE(sv));
+       {
            GP *gp;
             HV *stash;
 
@@ -1022,7 +1021,6 @@ PP(pp_undef)
 
            break;
        }
-       /* FALL THROUGH */
     default:
        if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
            SvPV_free(sv);
@@ -1042,7 +1040,7 @@ PP(pp_postinc)
     const bool inc =
        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(aTHX);
+       Perl_croak_no_modify();
     if (SvROK(TOPs))
        TARG = sv_newmortal();
     sv_setsv(TARG, TOPs);
@@ -2891,35 +2889,16 @@ PP(pp_length)
     dVAR; dSP; dTARGET;
     SV * const sv = TOPs;
 
-    if (SvGAMAGIC(sv)) {
-       /* For an overloaded or magic scalar, we can't know in advance if
-          it's going to be UTF-8 or not. Also, we can't call sv_len_utf8 as
-          it likes to cache the length. Maybe that should be a documented
-          feature of it.
-       */
-       STRLEN len;
-       const char *const p
-           = sv_2pv_flags(sv, &len,
-                          SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
-
-       if (!p) {
-           if (!SvPADTMP(TARG)) {
-               sv_setsv(TARG, &PL_sv_undef);
-               SETTARG;
-           }
-           SETs(&PL_sv_undef);
-       }
-       else if (DO_UTF8(sv)) {
-           SETi(utf8_length((U8*)p, (U8*)p + len));
-       }
-       else
-           SETi(len);
-    } else if (SvOK(sv)) {
-       /* Neither magic nor overloaded.  */
+    SvGETMAGIC(sv);
+    if (SvOK(sv)) {
        if (!IN_BYTES)
-           SETi(sv_len_utf8(sv));
+           SETi(sv_len_utf8_nomg(sv));
        else
-           SETi(sv_len(sv));
+       {
+           STRLEN len;
+           (void)SvPV_nomg_const(sv,len);
+           SETi(len);
+       }
     } else {
        if (!SvPADTMP(TARG)) {
            sv_setsv_nomg(TARG, &PL_sv_undef);
@@ -4826,20 +4805,30 @@ PP(pp_anonlist)
 PP(pp_anonhash)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    HV* const hv = newHV();
+    HV* const hv = (HV *)sv_2mortal((SV *)newHV());
 
     while (MARK < SP) {
-       SV * const key = *++MARK;
-       SV * const val = newSV(0);
+       SV * const key =
+           (MARK++, SvGMAGICAL(*MARK) ? sv_mortalcopy(*MARK) : *MARK);
+       SV *val;
        if (MARK < SP)
-           sv_setsv(val, *++MARK);
+       {
+           MARK++;
+           SvGETMAGIC(*MARK);
+           val = newSV(0);
+           sv_setsv(val, *MARK);
+       }
        else
+       {
            Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash");
+           val = newSV(0);
+       }
        (void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
-    mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
-           ? newRV_noinc(MUTABLE_SV(hv)) : MUTABLE_SV(hv));
+    if (PL_op->op_flags & OPf_SPECIAL)
+       mXPUSHs(newRV_inc(MUTABLE_SV(hv)));
+    else XPUSHs(MUTABLE_SV(hv));
     RETURN;
 }
 
@@ -5092,11 +5081,14 @@ PP(pp_push)
        SPAGAIN;
     }
     else {
+       if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify();
        PL_delaymagic = DM_DELAY;
        for (++MARK; MARK <= SP; MARK++) {
-           SV * const sv = newSV(0);
+           SV *sv;
+           if (*MARK) SvGETMAGIC(*MARK);
+           sv = newSV(0);
            if (*MARK)
-               sv_setsv(sv, *MARK);
+               sv_setsv_nomg(sv, *MARK);
            av_store(ary, AvFILLp(ary)+1, sv);
        }
        if (PL_delaymagic & DM_ARRAY_ISA)