This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update release managers guide with notes from 5.13.3 release
[perl5.git] / doop.c
diff --git a/doop.c b/doop.c
index b9c6fdc..c1a357c 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) {
@@ -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_no_modify(aTHX);
     }
     (void)SvPV_const(sv, len);
     if (!len)
@@ -809,9 +807,8 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
            }
 #ifdef UV_IS_QUAD
            else if (size == 64) {
-               if (ckWARN(WARN_PORTABLE))
-                   Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                               "Bit vector size > 32 non-portable");
+               Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                              "Bit vector size > 32 non-portable");
                if (uoffset >= srclen)
                    retnum = 0;
                else if (uoffset + 1 >= srclen)
@@ -877,9 +874,8 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
                      s[uoffset + 3];
 #ifdef UV_IS_QUAD
        else if (size == 64) {
-           if (ckWARN(WARN_PORTABLE))
-               Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                           "Bit vector size > 32 non-portable");
+           Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                          "Bit vector size > 32 non-portable");
            retnum =
                ((UV) s[uoffset    ] << 56) +
                ((UV) s[uoffset + 1] << 48) +
@@ -970,9 +966,8 @@ Perl_do_vecset(pTHX_ SV *sv)
        }
 #ifdef UV_IS_QUAD
        else if (size == 64) {
-           if (ckWARN(WARN_PORTABLE))
-               Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                           "Bit vector size > 32 non-portable");
+           Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
+                          "Bit vector size > 32 non-portable");
            s[offset  ] = (U8)((lval >> 56) & 0xff);
            s[offset+1] = (U8)((lval >> 48) & 0xff);
            s[offset+2] = (U8)((lval >> 40) & 0xff);
@@ -1022,7 +1017,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_no_modify(aTHX);
     }
 
     if (PL_encoding && !SvUTF8(sv)) {
@@ -1108,7 +1103,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_no_modify(aTHX);
     }
 
     if (PL_encoding) {
@@ -1196,8 +1191,7 @@ Perl_do_chomp(pTHX_ register SV *sv)
     }
   nope:
 
-    if (svrecode)
-        SvREFCNT_dec(svrecode);
+    SvREFCNT_dec(svrecode);
 
     Safefree(temp_buffer);
     return count;
@@ -1229,7 +1223,13 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 
     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
        sv_setpvs(sv, "");      /* avoid undef warning on |= and ^= */
-    lsave = lc = SvPV_nomg_const(left, leftlen);
+    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
@@ -1466,8 +1466,7 @@ Perl_do_kv(pTHX)
            }
            LvTYPE(TARG) = 'k';
            if (LvTARG(TARG) != (const SV *)keys) {
-               if (LvTARG(TARG))
-                   SvREFCNT_dec(LvTARG(TARG));
+               SvREFCNT_dec(LvTARG(TARG));
                LvTARG(TARG) = SvREFCNT_inc_simple(keys);
            }
            PUSHs(TARG);