Unify UTF-8 malformedness handling.

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

diff --git a/sv.c b/sv.c
index fd7d67d..139d98a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1,6 +1,6 @@
 /*    sv.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, 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.
@@ -1320,6 +1320,14 @@ See C<sv_setuv_mg>.
 void
 Perl_sv_setuv(pTHX_ register SV *sv, UV u)
 {
+    /* With these two if statements:
+       u=1.49  s=0.52  cu=72.49  cs=10.64  scripts=270  tests=20865
+       
+       without
+       u=1.35  s=0.47  cu=73.45  cs=11.43  scripts=270  tests=20865
+       
+       If you wish to remove them, please benchmark to see what the effect is
+    */
     if (u <= (UV)IV_MAX) {
        sv_setiv(sv, (IV)u);
        return;
@@ -1340,6 +1348,14 @@ Like C<sv_setuv>, but also handles 'set' magic.
 void
 Perl_sv_setuv_mg(pTHX_ register SV *sv, UV u)
 {
+    /* With these two if statements:
+       u=1.49  s=0.52  cu=72.49  cs=10.64  scripts=270  tests=20865
+       
+       without
+       u=1.35  s=0.47  cu=73.45  cs=11.43  scripts=270  tests=20865
+       
+       If you wish to remove them, please benchmark to see what the effect is
+    */
     if (u <= (UV)IV_MAX) {
        sv_setiv(sv, (IV)u);
     } else {
@@ -3501,7 +3517,7 @@ Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN
     Move(ptr,dptr,len,char);
     dptr[len] = '\0';
     SvCUR_set(sv, len);
-    (void)SvPOK_only(sv);              /* validate pointer */
+    (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
 }
 
@@ -3545,7 +3561,7 @@ Perl_sv_setpv(pTHX_ register SV *sv, register const char *ptr)
     SvGROW(sv, len + 1);
     Move(ptr,SvPVX(sv),len+1,char);
     SvCUR_set(sv, len);
-    (void)SvPOK_only(sv);              /* validate pointer */
+    (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
 }
 
@@ -3595,7 +3611,7 @@ Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
     SvCUR_set(sv, len);
     SvLEN_set(sv, len+1);
     *SvEND(sv) = '\0';
-    (void)SvPOK_only(sv);              /* validate pointer */
+    (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
 }
 
@@ -3732,27 +3748,42 @@ Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRL
 /*
 =for apidoc sv_catsv
 
-Concatenates the string from SV C<ssv> onto the end of the string in SV
-C<dsv>.  Handles 'get' magic, but not 'set' magic.  See C<sv_catsv_mg>.
+Concatenates the string from SV C<ssv> onto the end of the string in
+SV C<dsv>.  Modifies C<dsv> but not C<ssv>.  Handles 'get' magic, but
+not 'set' magic.  See C<sv_catsv_mg>.
 
-=cut
-*/
+=cut */
 
 void
-Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
+Perl_sv_catsv(pTHX_ SV *dsv, register SV *ssv)
 {
-    char *s;
-    STRLEN len;
-    if (!sstr)
+    char *spv;
+    STRLEN slen;
+    if (!ssv)
        return;
-    if ((s = SvPV(sstr, len))) {
-       if (DO_UTF8(sstr)) {
-           sv_utf8_upgrade(dstr);
-           sv_catpvn(dstr,s,len);
-           SvUTF8_on(dstr);
+    if ((spv = SvPV(ssv, slen))) {
+       bool dutf8 = DO_UTF8(dsv);
+       bool sutf8 = DO_UTF8(ssv);
+
+       if (dutf8 == sutf8)
+           sv_catpvn(dsv,spv,slen);
+       else {
+           if (dutf8) {
+               /* Not modifying source SV, so taking a temporary copy. */
+               SV* csv = sv_2mortal(newSVsv(ssv));
+               char *cpv;
+               STRLEN clen;
+
+               sv_utf8_upgrade(csv);
+               cpv = SvPV(csv,clen);
+               sv_catpvn(dsv,cpv,clen);
+           }
+           else {
+               sv_utf8_upgrade(dsv);
+               sv_catpvn(dsv,spv,slen);
+               SvUTF8_on(dsv); /* If dsv has no wide characters. */
+           }
        }
-       else
-           sv_catpvn(dstr,s,len);
     }
 }
 
@@ -3765,10 +3796,10 @@ Like C<sv_catsv>, but also handles 'set' magic.
 */
 
 void
-Perl_sv_catsv_mg(pTHX_ SV *dstr, register SV *sstr)
+Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
 {
-    sv_catsv(dstr,sstr);
-    SvSETMAGIC(dstr);
+    sv_catsv(dsv,ssv);
+    SvSETMAGIC(dsv);
 }
 
 /*
@@ -4575,17 +4606,18 @@ Perl_sv_pos_b2u(pTHX_ register SV *sv, I32* offsetp)
 
     s = (U8*)SvPV(sv, len);
     if (len < *offsetp)
-       Perl_croak(aTHX_ "panic: bad byte offset");
+       Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset");
     send = s + *offsetp;
     len = 0;
     while (s < send) {
-       s += UTF8SKIP(s);
-       ++len;
-    }
-    if (s != send) {
-       if (ckWARN_d(WARN_UTF8))
-           Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character");
-       --len;
+       STRLEN n;
+
+       if (utf8_to_uv(s, UTF8SKIP(s), &n, 0)) {
+           s += n;
+           len++;
+       }
+       else
+           break;
     }
     *offsetp = len;
     return;
@@ -4627,13 +4659,30 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
 
     /* do not utf8ize the comparands as a side-effect */
     if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE) {
+       if (PL_hints & HINT_UTF8_DISTINCT)
+           return FALSE;
+
        if (SvUTF8(sv1)) {
-           pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
-           pv2tmp = TRUE;
+           (void)utf8_to_bytes((U8*)(pv1 = savepvn(pv1, cur1)), &cur1);
+           {
+               IV scur1 = cur1;
+               if (scur1 < 0) {
+                   Safefree(pv1);
+                   return 0;
+               }
+           }
+           pv1tmp = TRUE;
        }
        else {
-           pv1 = (char*)bytes_to_utf8((U8*)pv1, &cur1);
-           pv1tmp = TRUE;
+           (void)utf8_to_bytes((U8*)(pv2 = savepvn(pv2, cur2)), &cur2);
+           {
+               IV scur2 = cur2;
+               if (scur2 < 0) {
+                   Safefree(pv2);
+                   return 0;
+               }
+           }
+           pv2tmp = TRUE;
        }
     }
 
@@ -4683,6 +4732,9 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
 
     /* do not utf8ize the comparands as a side-effect */
     if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE) {
+       if (PL_hints & HINT_UTF8_DISTINCT)
+           return SvUTF8(sv1) ? 1 : -1;
+
        if (SvUTF8(sv1)) {
            pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
            pv2tmp = TRUE;