Upgrade to Cwd 2.17_03

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

diff --git a/pp_hot.c b/pp_hot.c
index 4d87255..b7aad81 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,7 +1,7 @@
 /*    pp_hot.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -137,7 +137,7 @@ PP(pp_concat)
     bool lbyte;
     STRLEN rlen;
     char* rpv = SvPV(right, rlen);     /* mg_get(right) happens here */
-    bool rbyte = !SvUTF8(right), rcopied = FALSE;
+    bool rbyte = !DO_UTF8(right), rcopied = FALSE;
 
     if (TARG == right && right != left) {
        right = sv_2mortal(newSVpvn(rpv, rlen));
@@ -147,7 +147,7 @@ PP(pp_concat)
 
     if (TARG != left) {
        lpv = SvPV(left, llen);         /* mg_get(left) may happen here */
-       lbyte = !SvUTF8(left);
+       lbyte = !DO_UTF8(left);
        sv_setpvn(TARG, lpv, llen);
        if (!lbyte)
            SvUTF8_on(TARG);
@@ -160,7 +160,9 @@ PP(pp_concat)
        if (!SvOK(TARG))
            sv_setpv(left, "");
        lpv = SvPV_nomg(left, llen);
-       lbyte = !SvUTF8(left);
+       lbyte = !DO_UTF8(left);
+       if (IN_BYTES)
+           SvUTF8_off(TARG);
     }
 
 #if defined(PERL_Y2KWARN)
@@ -198,7 +200,7 @@ PP(pp_padsv)
     if (PL_op->op_flags & OPf_MOD) {
        if (PL_op->op_private & OPpLVAL_INTRO)
            SAVECLEARSV(PAD_SVl(PL_op->op_targ));
-        else if (PL_op->op_private & OPpDEREF) {
+        if (PL_op->op_private & OPpDEREF) {
            PUTBACK;
            vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF);
            SPAGAIN;
@@ -723,7 +725,7 @@ PP(pp_rv2av)
                      PL_op->op_private & HINT_STRICT_REFS)
                        DIE(aTHX_ PL_no_usym, "an ARRAY");
                    if (ckWARN(WARN_UNINITIALIZED))
-                       report_uninit();
+                       report_uninit(sv);
                    if (GIMME == G_ARRAY) {
                        (void)POPs;
                        RETURN;
@@ -776,7 +778,10 @@ PP(pp_rv2av)
            U32 i;
            for (i=0; i < (U32)maxarg; i++) {
                SV **svp = av_fetch(av, i, FALSE);
-               SP[i+1] = (svp) ? *svp : &PL_sv_undef;
+               /* See note in pp_helem, and bug id #27839 */
+               SP[i+1] = svp
+                   ? SvGMAGICAL(*svp) ? sv_mortalcopy(*svp) : *svp
+                   : &PL_sv_undef;
            }
        }
        else {
@@ -851,7 +856,7 @@ PP(pp_rv2hv)
                      PL_op->op_private & HINT_STRICT_REFS)
                        DIE(aTHX_ PL_no_usym, "a HASH");
                    if (ckWARN(WARN_UNINITIALIZED))
-                       report_uninit();
+                       report_uninit(sv);
                    if (gimme == G_ARRAY) {
                        SP--;
                        RETURN;
@@ -1819,7 +1824,7 @@ PP(pp_iter)
 {
     dSP;
     register PERL_CONTEXT *cx;
-    SV* sv;
+    SV *sv, *oldsv;
     AV* av;
     SV **itersvp;
 
@@ -1835,8 +1840,8 @@ PP(pp_iter)
        if (cx->blk_loop.iterlval) {
            /* string increment */
            register SV* cur = cx->blk_loop.iterlval;
-           STRLEN maxlen;
-           char *max = SvPV((SV*)av, maxlen);
+           STRLEN maxlen = 0;
+           char *max = SvOK((SV*)av) ? SvPV((SV*)av, maxlen) : "";
            if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
                if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
                    /* safe to reuse old SV */
@@ -1847,8 +1852,9 @@ PP(pp_iter)
                    /* we need a fresh SV every time so that loop body sees a
                     * completely new SV for closures/references to work as
                     * they used to */
-                   SvREFCNT_dec(*itersvp);
+                   oldsv = *itersvp;
                    *itersvp = newSVsv(cur);
+                   SvREFCNT_dec(oldsv);
                }
                if (strEQ(SvPVX(cur), max))
                    sv_setiv(cur, 0); /* terminate next time */
@@ -1872,8 +1878,9 @@ PP(pp_iter)
            /* we need a fresh SV every time so that loop body sees a
             * completely new SV for closures/references to work as they
             * used to */
-           SvREFCNT_dec(*itersvp);
+           oldsv = *itersvp;
            *itersvp = newSViv(cx->blk_loop.iterix++);
+           SvREFCNT_dec(oldsv);
        }
        RETPUSHYES;
     }
@@ -1882,8 +1889,6 @@ PP(pp_iter)
     if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av)))
        RETPUSHNO;
 
-    SvREFCNT_dec(*itersvp);
-
     if (SvMAGICAL(av) || AvREIFY(av)) {
        SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
        if (svp)
@@ -1923,7 +1928,10 @@ PP(pp_iter)
        sv = (SV*)lv;
     }
 
+    oldsv = *itersvp;
     *itersvp = SvREFCNT_inc(sv);
+    SvREFCNT_dec(oldsv);
+
     RETPUSHYES;
 }
 
@@ -2874,6 +2882,18 @@ PP(pp_aelem)
        RETPUSHUNDEF;
     svp = av_fetch(av, elem, lval && !defer);
     if (lval) {
+#ifdef PERL_MALLOC_WRAP
+        static const char oom_array_extend[] =
+             "Out of memory during array extend"; /* Duplicated in av.c */
+        if (SvUOK(elemsv)) {
+             UV uv = SvUV(elemsv);
+             elem = uv > IV_MAX ? IV_MAX : uv;
+        }
+        else if (SvNOK(elemsv))
+             elem = (IV)SvNV(elemsv);
+        if (elem > 0)
+             MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend);
+#endif
        if (!svp || *svp == &PL_sv_undef) {
            SV* lv;
            if (!defer)