more UTF8 test suites and an UTF8 patch

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 1dafbf6..3a32525 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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 {
@@ -1668,11 +1684,10 @@ S_sv_2iuv_non_preserve (pTHX_ register SV *sv, I32 numtype)
        }
        return IS_NUMBER_OVERFLOW_IV;
     }
-    return S_sv_2inuv_non_preserve (sv, numtype);
+    return S_sv_2inuv_non_preserve(aTHX_ sv, numtype);
 }
 #endif /* NV_PRESERVES_UV*/
 
-
 IV
 Perl_sv_2iv(pTHX_ register SV *sv)
 {
@@ -3502,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);
 }
 
@@ -3546,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);
 }
 
@@ -3596,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);
 }
 
@@ -3733,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)
 {
-    char *s;
-    STRLEN len;
+    char *spv;
+    STRLEN slen;
     if (!sstr)
        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(sstr, slen))) {
+       bool dutf8 = DO_UTF8(dstr);
+       bool sutf8 = DO_UTF8(sstr);
+
+       if (dutf8 == sutf8)
+           sv_catpvn(dstr,spv,slen);
+       else {
+           if (dutf8) {
+               SV* cstr = newSVsv(sstr);
+               char *cpv;
+               STRLEN clen;
+
+               sv_utf8_upgrade(cstr);
+               cpv = SvPV(cstr,clen);
+               sv_catpvn(dstr,cpv,clen);
+               sv_2mortal(cstr);
+           }
+           else {
+               sv_utf8_upgrade(dstr);
+               sv_catpvn(dstr,spv,slen);
+               SvUTF8_on(dstr);
+           }
        }
-       else
-           sv_catpvn(dstr,s,len);
     }
 }
 
@@ -4522,11 +4552,9 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
     if (!sv)
        return 0;
 
-#ifdef NOTYET
     if (SvGMAGICAL(sv))
        return mg_length(sv);
     else
-#endif
     {
        STRLEN len;
        U8 *s = (U8*)SvPV(sv, len);
@@ -4630,13 +4658,24 @@ 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);
+           if (cur1 < 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);
+           if (cur2 < 0) {
+               Safefree(pv2);
+               return 0;
+           }
+           pv2tmp = TRUE;
        }
     }
 
@@ -4686,6 +4725,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;