clarify note about shadow password support (from
[p5sagit/p5-mst-13.2.git] / doop.c
diff --git a/doop.c b/doop.c
index b064838..4224b0e 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -1,6 +1,6 @@
 /*    doop.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -282,7 +282,7 @@ S_do_trans_CU_simple(pTHX_ SV *sv)
     UV extra = none + 1;
     UV final;
     UV uv;
-    U8 tmpbuf[10];
+    U8 tmpbuf[UTF8_MAXLEN];
     I32 bits = 16;
 
     s = (U8*)SvPV(sv, len);
@@ -660,12 +660,9 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s
     if (items-- > 0) {
        char *s;
 
-       if (*mark) {
-           s = SvPV(*mark, tmplen);
-           sv_setpvn(sv, s, tmplen);
-       }
-       else
-           sv_setpv(sv, "");
+       sv_setpv(sv, "");
+       if (*mark)
+           sv_catsv(sv, *mark);
        mark++;
     }
     else
@@ -704,8 +701,10 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
     unsigned char *s = (unsigned char *) SvPV(sv, srclen);
     UV retnum = 0;
 
-    if (offset < 0 || size < 1)
+    if (offset < 0)
        return retnum;
+    if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ 
+       Perl_croak(aTHX_ "Illegal number of bits in vec");
     offset *= size;    /* turn into bit offset */
     len = (offset + size + 7) / 8;     /* required number of bytes */
     if (len > srclen) {
@@ -717,7 +716,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
                if (offset >= srclen)
                    retnum = 0;
                else
-                   retnum = (UV) s[offset] << 8;
+                   retnum = (UV) s[offset] <<  8;
            }
            else if (size == 32) {
                if (offset >= srclen)
@@ -735,8 +734,58 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
                        ((UV) s[offset + 1] << 16) +
                        (     s[offset + 2] <<  8);
            }
-           else
-               Perl_croak(aTHX_ "Illegal number of bits in vec");
+#ifdef UV_IS_QUAD
+           else if (size == 64) {
+               dTHR;
+               if (ckWARN(WARN_PORTABLE))
+                   Perl_warner(aTHX_ WARN_PORTABLE,
+                               "Bit vector size > 32 non-portable");
+               if (offset >= srclen)
+                   retnum = 0;
+               else if (offset + 1 >= srclen)
+                   retnum =
+                       (UV) s[offset     ] << 56;
+               else if (offset + 2 >= srclen)
+                   retnum =
+                       ((UV) s[offset    ] << 56) +
+                       ((UV) s[offset + 1] << 48);
+               else if (offset + 3 >= srclen)
+                   retnum =
+                       ((UV) s[offset    ] << 56) +
+                       ((UV) s[offset + 1] << 48) +
+                       ((UV) s[offset + 2] << 40);
+               else if (offset + 4 >= srclen)
+                   retnum =
+                       ((UV) s[offset    ] << 56) +
+                       ((UV) s[offset + 1] << 48) +
+                       ((UV) s[offset + 2] << 40) +
+                       ((UV) s[offset + 3] << 32);
+               else if (offset + 5 >= srclen)
+                   retnum =
+                       ((UV) s[offset    ] << 56) +
+                       ((UV) s[offset + 1] << 48) +
+                       ((UV) s[offset + 2] << 40) +
+                       ((UV) s[offset + 3] << 32) +
+                       (     s[offset + 4] << 24);
+               else if (offset + 6 >= srclen)
+                   retnum =
+                       ((UV) s[offset    ] << 56) +
+                       ((UV) s[offset + 1] << 48) +
+                       ((UV) s[offset + 2] << 40) +
+                       ((UV) s[offset + 3] << 32) +
+                       ((UV) s[offset + 4] << 24) +
+                       ((UV) s[offset + 5] << 16);
+               else
+                   retnum = 
+                       ((UV) s[offset    ] << 56) +
+                       ((UV) s[offset + 1] << 48) +
+                       ((UV) s[offset + 2] << 40) +
+                       ((UV) s[offset + 3] << 32) +
+                       ((UV) s[offset + 4] << 24) +
+                       ((UV) s[offset + 5] << 16) +
+                       (     s[offset + 6] <<  8);
+           }
+#endif
        }
     }
     else if (size < 8)
@@ -747,7 +796,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
            retnum = s[offset];
        else if (size == 16)
            retnum =
-               ((UV) s[offset] <<  8) +
+               ((UV) s[offset] <<      8) +
                      s[offset + 1];
        else if (size == 32)
            retnum =
@@ -755,8 +804,23 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
                ((UV) s[offset + 1] << 16) +
                (     s[offset + 2] <<  8) +
                      s[offset + 3];
-       else
-           Perl_croak(aTHX_ "Illegal number of bits in vec");
+#ifdef UV_IS_QUAD
+       else if (size == 64) {
+           dTHR;
+           if (ckWARN(WARN_PORTABLE))
+               Perl_warner(aTHX_ WARN_PORTABLE,
+                           "Bit vector size > 32 non-portable");
+           retnum =
+               ((UV) s[offset    ] << 56) +
+               ((UV) s[offset + 1] << 48) +
+               ((UV) s[offset + 2] << 40) +
+               ((UV) s[offset + 3] << 32) +
+               ((UV) s[offset + 4] << 24) +
+               ((UV) s[offset + 5] << 16) +
+               (     s[offset + 6] <<  8) +
+                     s[offset + 7];
+       }
+#endif
     }
 
     return retnum;
@@ -780,6 +844,8 @@ Perl_do_vecset(pTHX_ SV *sv)
     lval = SvUV(sv);
     offset = LvTARGOFF(sv);
     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");
     
     offset *= size;                    /* turn into bit offset */
     len = (offset + size + 7) / 8;     /* required number of bytes */
@@ -800,17 +866,33 @@ Perl_do_vecset(pTHX_ SV *sv)
     else {
        offset >>= 3;                   /* turn into byte offset */
        if (size == 8)
-           s[offset] = lval & 255;
+           s[offset  ] = lval         & 0xff;
        else if (size == 16) {
-           s[offset] = (lval >> 8) & 255;
-           s[offset+1] = lval & 255;
+           s[offset  ] = (lval >>  8) & 0xff;
+           s[offset+1] = lval         & 0xff;
        }
        else if (size == 32) {
-           s[offset] = (lval >> 24) & 255;
-           s[offset+1] = (lval >> 16) & 255;
-           s[offset+2] = (lval >> 8) & 255;
-           s[offset+3] = lval & 255;
+           s[offset  ] = (lval >> 24) & 0xff;
+           s[offset+1] = (lval >> 16) & 0xff;
+           s[offset+2] = (lval >>  8) & 0xff;
+           s[offset+3] =  lval        & 0xff;
        }
+#ifdef UV_IS_QUAD
+       else if (size == 64) {
+           dTHR;
+           if (ckWARN(WARN_PORTABLE))
+               Perl_warner(aTHX_ 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;
+       }
+#endif
     }
     SvSETMAGIC(targ);
 }
@@ -839,7 +921,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
        HE* entry;
         (void)hv_iterinit(hv);
         /*SUPPRESS 560*/
-        while (entry = hv_iternext(hv))
+        while ((entry = hv_iternext(hv)))
             do_chop(astr,hv_iterval(hv,entry));
         return;
     }
@@ -848,7 +930,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
     s = SvPV(sv, len);
     if (len && !SvPOK(sv))
        s = SvPV_force(sv, len);
-    if (IN_UTF8) {
+    if (DO_UTF8(sv)) {
        if (s && len) {
            char *send = s + len;
            char *start = s;
@@ -861,22 +943,23 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
            *s = '\0';
            SvCUR_set(sv, s - start);
            SvNIOK_off(sv);
+           SvUTF8_on(astr);
        }
        else
            sv_setpvn(astr, "", 0);
     }
-    else
-    if (s && len) {
+    else if (s && len) {
        s += --len;
        sv_setpvn(astr, s, 1);
        *s = '\0';
        SvCUR_set(sv, len);
+       SvUTF8_off(sv);
        SvNIOK_off(sv);
     }
     else
        sv_setpvn(astr, "", 0);
     SvSETMAGIC(sv);
-} 
+}
 
 I32
 Perl_do_chomp(pTHX_ register SV *sv)
@@ -908,7 +991,7 @@ Perl_do_chomp(pTHX_ register SV *sv)
        HE* entry;
         (void)hv_iterinit(hv);
         /*SUPPRESS 560*/
-        while (entry = hv_iternext(hv))
+        while ((entry = hv_iternext(hv)))
             count += do_chomp(hv_iterval(hv,entry));
         return count;
     }
@@ -974,6 +1057,13 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     I32 lensave;
     char *lsave;
     char *rsave;
+    bool left_utf = DO_UTF8(left);
+    bool right_utf = DO_UTF8(right);
+
+    if (left_utf && !right_utf)
+       sv_utf8_upgrade(right);
+    if (!left_utf && right_utf)
+       sv_utf8_upgrade(left);
 
     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
        sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
@@ -998,6 +1088,69 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     }
     SvCUR_set(sv, len);
     (void)SvPOK_only(sv);
+    if (left_utf || right_utf) {
+       UV duc, luc, ruc;
+       STRLEN lulen = leftlen;
+       STRLEN rulen = rightlen;
+       STRLEN dulen = 0;
+       I32 ulen;
+
+       if (optype != OP_BIT_AND)
+           dc = SvGROW(sv, leftlen+rightlen+1);
+
+       switch (optype) {
+       case OP_BIT_AND:
+           while (lulen && rulen) {
+               luc = utf8_to_uv((U8*)lc, &ulen);
+               lc += ulen;
+               lulen -= ulen;
+               ruc = utf8_to_uv((U8*)rc, &ulen);
+               rc += ulen;
+               rulen -= ulen;
+               duc = luc & ruc;
+               dc = (char*)uv_to_utf8((U8*)dc, duc);
+           }
+           dulen = dc - SvPVX(sv);
+           SvCUR_set(sv, dulen);
+           break;
+       case OP_BIT_XOR:
+           while (lulen && rulen) {
+               luc = utf8_to_uv((U8*)lc, &ulen);
+               lc += ulen;
+               lulen -= ulen;
+               ruc = utf8_to_uv((U8*)rc, &ulen);
+               rc += ulen;
+               rulen -= ulen;
+               duc = luc ^ ruc;
+               dc = (char*)uv_to_utf8((U8*)dc, duc);
+           }
+           goto mop_up_utf;
+       case OP_BIT_OR:
+           while (lulen && rulen) {
+               luc = utf8_to_uv((U8*)lc, &ulen);
+               lc += ulen;
+               lulen -= ulen;
+               ruc = utf8_to_uv((U8*)rc, &ulen);
+               rc += ulen;
+               rulen -= ulen;
+               duc = luc | ruc;
+               dc = (char*)uv_to_utf8((U8*)dc, duc);
+           }
+         mop_up_utf:
+           dulen = dc - SvPVX(sv);
+           SvCUR_set(sv, dulen);
+           if (rulen)
+               sv_catpvn(sv, rc, rulen);
+           else if (lulen)
+               sv_catpvn(sv, lc, lulen);
+           else
+               *SvEND(sv) = '\0';
+           break;
+       }
+       SvUTF8_on(sv);
+       goto finish;
+    }
+    else
 #ifdef LIBERAL
     if (len >= sizeof(long)*4 &&
        !((long)dc % sizeof(long)) &&
@@ -1068,6 +1221,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
            break;
        }
     }
+finish:
     SvTAINT(sv);
 }
 
@@ -1136,7 +1290,7 @@ Perl_do_kv(pTHX)
     EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
 
     PUTBACK;   /* hv_iternext and hv_iterval might clobber stack_sp */
-    while (entry = hv_iternext(keys)) {
+    while ((entry = hv_iternext(keys))) {
        SPAGAIN;
        if (dokeys)
            XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */