This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate change #9108 from maintperl to mainline.
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index c2c1cc0..36735ae 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -63,7 +63,7 @@ static void do_clean_all(pTHXo_ SV *sv);
 #define del_SV(p) \
     STMT_START {                                       \
        LOCK_SV_MUTEX;                                  \
-       if (PL_debug & 32768)                           \
+       if (DEBUG_D_TEST)                               \
            del_sv(p);                                  \
        else                                            \
            plant_SV(p);                                \
@@ -73,7 +73,7 @@ static void do_clean_all(pTHXo_ SV *sv);
 STATIC void
 S_del_sv(pTHX_ SV *p)
 {
-    if (PL_debug & 32768) {
+    if (DEBUG_D_TEST) {
        SV* sva;
        SV* sv;
        SV* svend;
@@ -2884,7 +2884,8 @@ Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
 char *
 Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
 {
-    return sv_2pv(sv,lp);
+    sv_utf8_downgrade(sv,0);
+    return SvPV(sv,*lp);
 }
 
 char *
@@ -3031,9 +3032,8 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
            }
            SvCUR(sv) = len;
        }
-       SvUTF8_off(sv);
     }
-
+    SvUTF8_off(sv);
     return TRUE;
 }
 
@@ -4369,7 +4369,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
 
     if (SvOBJECT(sv)) {
        if (PL_defstash) {              /* Still have a symbol table? */
-           djSP;
+           dSP;
            CV* destructor;
            SV tmpref;
 
@@ -4704,8 +4704,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++;
        }
@@ -6152,18 +6152,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);
 }
 
@@ -7098,7 +7101,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 {
@@ -7182,7 +7185,7 @@ 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;
@@ -7262,7 +7265,7 @@ 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;
@@ -8176,7 +8179,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: