set SvUTF8 on vectors only if there are chars > 127; update copyright

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

diff --git a/sv.c b/sv.c
index d76752f..0cf3b4c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1,6 +1,6 @@
 /*    sv.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.
@@ -3046,7 +3046,7 @@ Perl_sv_catpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN
     Move(ptr,SvPVX(sv)+tlen,len,char);
     SvCUR(sv) += len;
     *SvEND(sv) = '\0';
-    (void)SvPOK_only(sv);              /* validate pointer */
+    (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
 }
 
@@ -3083,6 +3083,8 @@ Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
        return;
     if (s = SvPV(sstr, len))
        sv_catpvn(dstr,s,len);
+    if (SvUTF8(sstr))
+       SvUTF8_on(dstr);
 }
 
 /*
@@ -3125,7 +3127,7 @@ Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr)
        ptr = SvPVX(sv);
     Move(ptr,SvPVX(sv)+tlen,len+1,char);
     SvCUR(sv) += len;
-    (void)SvPOK_only(sv);              /* validate pointer */
+    (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
 }
 
@@ -5828,7 +5830,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                uv = va_arg(*args, int);
            else
                uv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
-           if (uv >= 128 && !IN_BYTE) {
+           if (uv >= 128 && PL_bigchar && !IN_BYTE) {
                eptr = (char*)utf8buf;
                elen = uv_to_utf8((U8*)eptr, uv) - utf8buf;
                is_utf = TRUE;
@@ -5873,6 +5875,60 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            }
            goto string;
 
+       case 'v':
+           if (args)
+               argsv = va_arg(*args, SV*);
+           else if (svix < svmax)
+               argsv = svargs[svix++];
+           {
+               STRLEN len;
+               U8 *str = (U8*)SvPVx(argsv,len);
+               I32 vlen = len*3;
+               SV *vsv = NEWSV(73,vlen);
+               I32 ulen;
+               U8 *vptr = (U8*)SvPVX(vsv);
+               STRLEN vcur = 0;
+               bool utf = DO_UTF8(argsv);
+
+               if (utf)
+                   is_utf = TRUE;
+               while (len) {
+                   UV uv;
+
+                   if (utf)
+                       uv = utf8_to_uv(str, &ulen);
+                   else {
+                       uv = *str;
+                       ulen = 1;
+                   }
+                   str += ulen;
+                   len -= ulen;
+                   eptr = ebuf + sizeof ebuf;
+                   if (elen >= vlen-1) {
+                       STRLEN off = vptr - (U8*)SvPVX(vsv);
+                       vlen *= 2;
+                       SvGROW(vsv, vlen);
+                       vptr = SvPVX(vsv) + off;
+                   }
+                   do {
+                       *--eptr = '0' + uv % 10;
+                   } while (uv /= 10);
+                   elen = (ebuf + sizeof ebuf) - eptr;
+                   memcpy(vptr, eptr, elen);
+                   vptr += elen;
+                   *vptr++ = '.';
+                   vcur += elen + 1;
+               }
+               if (vcur) {
+                   vcur--;
+                   vptr[-1] = '\0';
+               }
+               SvCUR_set(vsv,vcur);
+               eptr = SvPVX(vsv);
+               elen = vcur;
+           }
+           goto string;
+
        case '_':
            /*
             * The "%_" hack might have to be changed someday,
@@ -6396,7 +6452,7 @@ void *
 Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv)
 {
     PTR_TBL_ENT_t *tblent;
-    UV hash = (UV)sv;
+    UV hash = PTR2UV(sv);
     assert(tbl);
     tblent = tbl->tbl_ary[hash & tbl->tbl_max];
     for (; tblent; tblent = tblent->next) {
@@ -6413,7 +6469,7 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
     /* XXX this may be pessimal on platforms where pointers aren't good
      * hash values e.g. if they grow faster in the most significant
      * bits */
-    UV hash = (UV)oldv;
+    UV hash = PTR2UV(oldv);
     bool i = 1;
 
     assert(tbl);
@@ -6453,7 +6509,7 @@ Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
            continue;
        curentp = ary + oldsize;
        for (entp = ary, ent = *ary; ent; ent = *entp) {
-           if ((newsize & (UV)ent->oldval) != i) {
+           if ((newsize & PTR2UV(ent->oldval)) != i) {
                *entp = ent->next;
                ent->next = *curentp;
                *curentp = ent;
@@ -7147,6 +7203,10 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
            i = POPINT(ss,ix);
            TOPINT(nss,ix) = i;
            break;
+       case SAVEt_COMPPAD:
+           av = (AV*)POPPTR(ss,ix);
+           TOPPTR(nss,ix) = av_dup(av);
+           break;
        default:
            Perl_croak(aTHX_ "panic: ss_dup inconsistency");
        }