This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Remove redundant targets from Win32 Makefile
[perl5.git] / doop.c
diff --git a/doop.c b/doop.c
index d59dba6..e5c3d1c 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -1,6 +1,7 @@
 /*    doop.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 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.
@@ -46,7 +47,7 @@ S_do_trans_simple(pTHX_ SV *sv)
        while (s < send) {
            if ((ch = tbl[*s]) >= 0) {
                matches++;
-               *s++ = ch;
+               *s++ = (U8)ch;
            }
            else
                s++;
@@ -159,7 +160,7 @@ S_do_trans_complex(pTHX_ SV *sv)
            U8* p = send;
            while (s < send) {
                if ((ch = tbl[*s]) >= 0) {
-                   *d = ch;
+                   *d = (U8)ch;
                    matches++;
                    if (p != d - 1 || *p != *d)
                        p = d++;
@@ -175,7 +176,7 @@ S_do_trans_complex(pTHX_ SV *sv)
            while (s < send) {
                if ((ch = tbl[*s]) >= 0) {
                    matches++;
-                   *d++ = ch;
+                   *d++ = (U8)ch;
                }
                else if (ch == -1)      /* -1 is unmapped character */
                    *d++ = *s;
@@ -217,9 +218,9 @@ S_do_trans_complex(pTHX_ SV *sv)
                            ch = (rlen == 0) ? comp :
                                (comp - 0x100 < rlen) ?
                                tbl[comp+1] : tbl[0x100+rlen];
-                           if (ch != pch) {
+                           if ((UV)ch != pch) {
                                d = uvchr_to_utf8(d, ch);
-                               pch = ch;
+                               pch = (UV)ch;
                            }
                            s += len;
                            continue;
@@ -228,9 +229,9 @@ S_do_trans_complex(pTHX_ SV *sv)
                }
                else if ((ch = tbl[comp]) >= 0) {
                    matches++;
-                   if (ch != pch) {
+                   if ((UV)ch != pch) {
                        d = uvchr_to_utf8(d, ch);
-                       pch = ch;
+                       pch = (UV)ch;
                    }
                    s += len;
                    continue;
@@ -600,18 +601,19 @@ Perl_do_trans(pTHX_ SV *sv)
                     (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF));
 
     if (SvREADONLY(sv)) {
-        if (SvFAKE(sv))
-            sv_force_normal(sv);
+        if (SvIsCOW(sv))
+            sv_force_normal_flags(sv, 0);
         if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL))
             Perl_croak(aTHX_ PL_no_modify);
     }
     (void)SvPV(sv, len);
     if (!len)
        return 0;
-    if (!SvPOKp(sv))
-       (void)SvPV_force(sv, len);
-    if (!(PL_op->op_private & OPpTRANS_IDENTICAL))
+    if (!(PL_op->op_private & OPpTRANS_IDENTICAL)) {
+       if (!SvPOKp(sv))
+           (void)SvPV_force(sv, len);
        (void)SvPOK_only_UTF8(sv);
+    }
 
     DEBUG_t( Perl_deb(aTHX_ "2.TBL\n"));
 
@@ -730,18 +732,18 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
        else {
            offset >>= 3;       /* turn into byte offset */
            if (size == 16) {
-               if (offset >= srclen)
+               if ((STRLEN)offset >= srclen)
                    retnum = 0;
                else
                    retnum = (UV) s[offset] <<  8;
            }
            else if (size == 32) {
-               if (offset >= srclen)
+               if ((STRLEN)offset >= srclen)
                    retnum = 0;
-               else if (offset + 1 >= srclen)
+               else if ((STRLEN)(offset + 1) >= srclen)
                    retnum =
                        ((UV) s[offset    ] << 24);
-               else if (offset + 2 >= srclen)
+               else if ((STRLEN)(offset + 2) >= srclen)
                    retnum =
                        ((UV) s[offset    ] << 24) +
                        ((UV) s[offset + 1] << 16);
@@ -754,7 +756,7 @@ 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_ WARN_PORTABLE,
+                   Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                                "Bit vector size > 32 non-portable");
                if (offset >= srclen)
                    retnum = 0;
@@ -823,7 +825,7 @@ 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_ WARN_PORTABLE,
+               Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                            "Bit vector size > 32 non-portable");
            retnum =
                ((UV) s[offset    ] << 56) +
@@ -872,7 +874,7 @@ Perl_do_vecset(pTHX_ SV *sv)
     lval = SvUV(sv);
     offset = LvTARGOFF(sv);
     if (offset < 0)
-       Perl_croak(aTHX_ "Assigning to negative offset in vec");
+       Perl_croak(aTHX_ "Negative offset to vec in lvalue context");
     size = LvTARGLEN(sv);
     if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
        Perl_croak(aTHX_ "Illegal number of bits in vec");
@@ -896,30 +898,30 @@ Perl_do_vecset(pTHX_ SV *sv)
     else {
        offset >>= 3;                   /* turn into byte offset */
        if (size == 8)
-           s[offset  ] = lval         & 0xff;
+           s[offset  ] = (U8)( lval        & 0xff);
        else if (size == 16) {
-           s[offset  ] = (lval >>  8) & 0xff;
-           s[offset+1] = lval         & 0xff;
+           s[offset  ] = (U8)((lval >>  8) & 0xff);
+           s[offset+1] = (U8)( lval        & 0xff);
        }
        else if (size == 32) {
-           s[offset  ] = (lval >> 24) & 0xff;
-           s[offset+1] = (lval >> 16) & 0xff;
-           s[offset+2] = (lval >>  8) & 0xff;
-           s[offset+3] =  lval        & 0xff;
+           s[offset  ] = (U8)((lval >> 24) & 0xff);
+           s[offset+1] = (U8)((lval >> 16) & 0xff);
+           s[offset+2] = (U8)((lval >>  8) & 0xff);
+           s[offset+3] = (U8)( lval        & 0xff);
        }
 #ifdef UV_IS_QUAD
        else if (size == 64) {
            if (ckWARN(WARN_PORTABLE))
-               Perl_warner(aTHX_ WARN_PORTABLE,
+               Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                            "Bit vector size > 32 non-portable");
-           s[offset  ] = (lval >> 56) & 0xff;
-           s[offset+1] = (lval >> 48) & 0xff;
-           s[offset+2] = (lval >> 40) & 0xff;
-           s[offset+3] = (lval >> 32) & 0xff;
-           s[offset+4] = (lval >> 24) & 0xff;
-           s[offset+5] = (lval >> 16) & 0xff;
-           s[offset+6] = (lval >>  8) & 0xff;
-           s[offset+7] =  lval        & 0xff;
+           s[offset  ] = (U8)((lval >> 56) & 0xff);
+           s[offset+1] = (U8)((lval >> 48) & 0xff);
+           s[offset+2] = (U8)((lval >> 40) & 0xff);
+           s[offset+3] = (U8)((lval >> 32) & 0xff);
+           s[offset+4] = (U8)((lval >> 24) & 0xff);
+           s[offset+5] = (U8)((lval >> 16) & 0xff);
+           s[offset+6] = (U8)((lval >>  8) & 0xff);
+           s[offset+7] = (U8)( lval        & 0xff);
        }
 #endif
     }
@@ -1117,8 +1119,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
        STRLEN n_a;
        dc = SvPV_force(sv, n_a);
-       if (SvCUR(sv) < len) {
-           dc = SvGROW(sv, len + 1);
+       if (SvCUR(sv) < (STRLEN)len) {
+           dc = SvGROW(sv, (STRLEN)(len + 1));
            (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
        }
        if (optype != OP_BIT_AND && (left_utf || right_utf))
@@ -1256,9 +1258,9 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
                *dc++ = *lc++ | *rc++;
          mop_up:
            len = lensave;
-           if (rightlen > len)
+           if (rightlen > (STRLEN)len)
                sv_catpvn(sv, rsave + len, rightlen - len);
-           else if (leftlen > len)
+           else if (leftlen > (STRLEN)len)
                sv_catpvn(sv, lsave + len, leftlen - len);
            else
                *SvEND(sv) = '\0';
@@ -1280,7 +1282,6 @@ Perl_do_kv(pTHX)
     I32 gimme = GIMME_V;
     I32 dokeys =   (PL_op->op_type == OP_KEYS);
     I32 dovalues = (PL_op->op_type == OP_VALUES);
-    I32 realhv = (SvTYPE(hv) == SVt_PVHV);
 
     if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV)
        dokeys = dovalues = TRUE;
@@ -1295,7 +1296,7 @@ Perl_do_kv(pTHX)
        RETURN;
     }
 
-    keys = realhv ? hv : avhv_keys((AV*)hv);
+    keys = hv;
     (void)hv_iterinit(keys);   /* always reset iterator regardless */
 
     if (gimme == G_VOID)
@@ -1336,12 +1337,13 @@ Perl_do_kv(pTHX)
     PUTBACK;   /* hv_iternext and hv_iterval might clobber stack_sp */
     while ((entry = hv_iternext(keys))) {
        SPAGAIN;
-       if (dokeys)
-           XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
+       if (dokeys) {
+           SV* sv = hv_iterkeysv(entry);
+           XPUSHs(sv); /* won't clobber stack_sp */
+       }
        if (dovalues) {
            PUTBACK;
-           tmpstr = realhv ?
-                    hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry);
+           tmpstr = hv_iterval(hv,entry);
            DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu",
                            (unsigned long)HeHASH(entry),
                            HvMAX(keys)+1,
Unnamed repository; edit this file 'description' to name the repository.