With Damian's approval synchronize damian's modules'

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

diff --git a/sv.c b/sv.c
index 0fff206..b96cc45 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3013,15 +3013,37 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
 {
     if (SvPOK(sv) && SvUTF8(sv)) {
         if (SvCUR(sv)) {
-           char *s;
+           U8 *s;
            STRLEN len;
 
            if (SvREADONLY(sv) && SvFAKE(sv))
                sv_force_normal(sv);
-           s = SvPV(sv, len);
-           if (!utf8_to_bytes((U8*)s, &len)) {
+           s = (U8 *) SvPV(sv, len);
+           if (!utf8_to_bytes(s, &len)) {
                if (fail_ok)
                    return FALSE;
+#ifdef USE_BYTES_DOWNGRADES
+               else if (IN_BYTE) {
+                   U8 *d = s;
+                   U8 *e = (U8 *) SvEND(sv);
+                   int first = 1;
+                   while (s < e) {
+                       UV ch = utf8n_to_uvchr(s,(e-s),&len,0);
+                       if (first && ch > 255) {
+                           if (PL_op)
+                               Perl_warner(aTHX_ WARN_UTF8, "Wide character in byte %s",
+                                          PL_op_desc[PL_op->op_type]);
+                           else
+                               Perl_warner(aTHX_ WARN_UTF8, "Wide character in byte");
+                           first = 0;
+                       }
+                       *d++ = ch;
+                       s += len;
+                   }
+                   *d = '\0';
+                   len = (d - (U8 *) SvPVX(sv));
+               }
+#endif
                else {
                    if (PL_op)
                        Perl_croak(aTHX_ "Wide character in %s",
@@ -3032,9 +3054,8 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
            }
            SvCUR(sv) = len;
        }
-       SvUTF8_off(sv);
     }
-
+    SvUTF8_off(sv);
     return TRUE;
 }
 
@@ -4705,8 +4726,8 @@ Perl_sv_pos_b2u(pTHX_ register SV *sv, I32* offsetp)
     len = 0;
     while (s < send) {
        STRLEN n;
-
-       if (utf8_to_uv(s, UTF8SKIP(s), &n, 0)) {
+        /* We can use low level directly here as we are not looking at the values */
+       if (utf8n_to_uvuni(s, UTF8SKIP(s), &n, 0)) {
            s += n;
            len++;
        }
@@ -6153,18 +6174,21 @@ Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
 char *
 Perl_sv_pvbyte(pTHX_ SV *sv)
 {
+    sv_utf8_downgrade(sv,0);
     return sv_pv(sv);
 }
 
 char *
 Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
 {
+    sv_utf8_downgrade(sv,0);
     return sv_pvn(sv,lp);
 }
 
 char *
 Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp)
 {
+    sv_utf8_downgrade(sv,0);
     return sv_pvn_force(sv,lp);
 }
 
@@ -7099,7 +7123,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            uv = args ? va_arg(*args, int) : SvIVx(argsv);
            if ((uv > 255 || (uv > 127 && SvUTF8(sv))) && !IN_BYTE) {
                eptr = (char*)utf8buf;
-               elen = uv_to_utf8((U8*)eptr, uv) - utf8buf;
+               elen = uvchr_to_utf8((U8*)eptr, uv) - utf8buf;
                is_utf = TRUE;
            }
            else {
@@ -7183,13 +7207,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                if (!veclen)
                    continue;
                if (vec_utf)
-                   iv = (IV)utf8_to_uv(vecstr, veclen, &ulen, 0);
+                   iv = (IV)utf8n_to_uvchr(vecstr, veclen, &ulen, 0);
                else {
                    iv = *vecstr;
                    ulen = 1;
                }
-               if (iv <256) 
-               iv = NATIVE_TO_ASCII(iv); /* v-strings are codepoints */
                vecstr += ulen;
                veclen -= ulen;
            }
@@ -7265,13 +7287,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                if (!veclen)
                    continue;
                if (vec_utf)
-                   uv = utf8_to_uv(vecstr, veclen, &ulen, 0);
+                   uv = utf8n_to_uvchr(vecstr, veclen, &ulen, 0);
                else {
                    uv = *vecstr;
                    ulen = 1;
                }
-               if (uv <256) 
-               uv = NATIVE_TO_ASCII(uv); /* v-strings are codepoints */
                vecstr += ulen;
                veclen -= ulen;
            }
@@ -8181,7 +8201,10 @@ dup_pvcv:
        }
        else
            CvPADLIST(dstr)     = av_dup_inc(CvPADLIST(sstr));
-       CvOUTSIDE(dstr) = cv_dup_inc(CvOUTSIDE(sstr));
+       if (!CvANON(sstr) || CvCLONED(sstr))
+           CvOUTSIDE(dstr)     = cv_dup_inc(CvOUTSIDE(sstr));
+       else
+           CvOUTSIDE(dstr)     = cv_dup(CvOUTSIDE(sstr));
        CvFLAGS(dstr)   = CvFLAGS(sstr);
        break;
     default: