Merge branch 'blead' into dual/Safe

[perl5.git] / doop.c

diff --git a/doop.c b/doop.c
index db97cd5..5cce7ed 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -1,7 +1,7 @@
 /*    doop.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
- *    2001, 2002, 2004, 2005, 2006, 2007, 2008, by Larry Wall and others
+ *    2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009 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.
@@ -9,7 +9,9 @@
  */
 
 /*
- * "'So that was the job I felt I had to do when I started,' thought Sam."
+ *  'So that was the job I felt I had to do when I started,' thought Sam.
+ *
+ *     [p.934 of _The Lord of the Rings_, VI/iii: "Mount Doom"]
  */
 
 /* This file contains some common functions needed to carry out certain
@@ -201,10 +203,6 @@ S_do_trans_complex(pTHX_ SV * const sv)
        if (complement && !del)
            rlen = tbl[0x100];
 
-#ifdef MACOS_TRADITIONAL
-#define comp CoMP   /* "comp" is a keyword in some compilers ... */
-#endif
-
        if (PL_op->op_private & OPpTRANS_SQUASH) {
            UV pch = 0xfeedface;
            while (s < send) {
@@ -316,7 +314,7 @@ S_do_trans_simple_utf8(pTHX_ SV * const sv)
 #ifdef USE_ITHREADS
                    PAD_SVl(cPADOP->op_padix);
 #else
-                   (SV*)cSVOP->op_sv;
+                   MUTABLE_SV(cSVOP->op_sv);
 #endif
     HV* const  hv = MUTABLE_HV(SvRV(rv));
     SV* const * svp = hv_fetchs(hv, "NONE", FALSE);
@@ -418,7 +416,7 @@ S_do_trans_count_utf8(pTHX_ SV * const sv)
 #ifdef USE_ITHREADS
                    PAD_SVl(cPADOP->op_padix);
 #else
-                   (SV*)cSVOP->op_sv;
+                   MUTABLE_SV(cSVOP->op_sv);
 #endif
     HV* const hv = MUTABLE_HV(SvRV(rv));
     SV* const * const svp = hv_fetchs(hv, "NONE", FALSE);
@@ -469,7 +467,7 @@ S_do_trans_complex_utf8(pTHX_ SV * const sv)
 #ifdef USE_ITHREADS
                    PAD_SVl(cPADOP->op_padix);
 #else
-                   (SV*)cSVOP->op_sv;
+                   MUTABLE_SV(cSVOP->op_sv);
 #endif
     HV * const hv = MUTABLE_HV(SvRV(rv));
     SV * const *svp = hv_fetchs(hv, "NONE", FALSE);
@@ -637,7 +635,7 @@ Perl_do_trans(pTHX_ SV *sv)
         if (SvIsCOW(sv))
             sv_force_normal_flags(sv, 0);
         if (SvREADONLY(sv))
-            Perl_croak(aTHX_ PL_no_modify);
+            Perl_croak(aTHX_ "%s", PL_no_modify);
     }
     (void)SvPV_const(sv, len);
     if (!len)
@@ -707,7 +705,7 @@ Perl_do_join(pTHX_ register SV *sv, SV *delim, register SV **mark, register SV *
        ++mark;
     }
 
-    sv_setpvn(sv, "", 0);
+    sv_setpvs(sv, "");
     /* sv_setpv retains old UTF8ness [perl #24846] */
     SvUTF8_off(sv);
 
@@ -1002,7 +1000,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
        const I32 max = AvFILL(av);
 
        for (i = 0; i <= max; i++) {
-           sv = (SV*)av_fetch(av, i, FALSE);
+           sv = MUTABLE_SV(av_fetch(av, i, FALSE));
            if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
                do_chop(astr, sv);
        }
@@ -1022,7 +1020,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
            sv_force_normal_flags(sv, 0);
         }
         if (SvREADONLY(sv))
-            Perl_croak(aTHX_ PL_no_modify);
+            Perl_croak(aTHX_ "%s", PL_no_modify);
     }
 
     if (PL_encoding && !SvUTF8(sv)) {
@@ -1050,7 +1048,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
            }
        }
        else
-           sv_setpvn(astr, "", 0);
+           sv_setpvs(astr, "");
     }
     else if (s && len) {
        s += --len;
@@ -1061,7 +1059,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
        SvNIOK_off(sv);
     }
     else
-       sv_setpvn(astr, "", 0);
+       sv_setpvs(astr, "");
     SvSETMAGIC(sv);
 }
 
@@ -1088,7 +1086,7 @@ Perl_do_chomp(pTHX_ register SV *sv)
        const I32 max = AvFILL(av);
 
        for (i = 0; i <= max; i++) {
-           sv = (SV*)av_fetch(av, i, FALSE);
+           sv = MUTABLE_SV(av_fetch(av, i, FALSE));
            if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
                count += do_chomp(sv);
        }
@@ -1108,7 +1106,7 @@ Perl_do_chomp(pTHX_ register SV *sv)
            sv_force_normal_flags(sv, 0);
         }
         if (SvREADONLY(sv))
-            Perl_croak(aTHX_ PL_no_modify);
+            Perl_croak(aTHX_ "%s", PL_no_modify);
     }
 
     if (PL_encoding) {
@@ -1228,8 +1226,14 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     PERL_ARGS_ASSERT_DO_VOP;
 
     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
-       sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
-    lsave = lc = SvPV_nomg_const(left, leftlen);
+       sv_setpvs(sv, "");      /* avoid undef warning on |= and ^= */
+    if (sv == left) {
+       lsave = lc = SvPV_force_nomg(left, leftlen);
+    }
+    else {
+       lsave = lc = SvPV_nomg_const(left, leftlen);
+       SvPV_force_nomg_nolen(sv);
+    }
     rsave = rc = SvPV_nomg_const(right, rightlen);
 
     /* This need to come after SvPV to ensure that string overloading has
@@ -1465,7 +1469,7 @@ Perl_do_kv(pTHX)
                sv_magic(TARG, NULL, PERL_MAGIC_nkeys, NULL, 0);
            }
            LvTYPE(TARG) = 'k';
-           if (LvTARG(TARG) != (SV*)keys) {
+           if (LvTARG(TARG) != (const SV *)keys) {
                if (LvTARG(TARG))
                    SvREFCNT_dec(LvTARG(TARG));
                LvTARG(TARG) = SvREFCNT_inc_simple(keys);
@@ -1474,7 +1478,7 @@ Perl_do_kv(pTHX)
            RETURN;
        }
 
-       if (! SvTIED_mg((SV*)keys, PERL_MAGIC_tied) )
+       if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) )
        {
            i = HvKEYS(keys);
        }