This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove iconv references since we are not using it
[perl5.git] / doop.c
diff --git a/doop.c b/doop.c
index b3c4acb..8600b7c 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -36,7 +36,7 @@ S_do_trans_simple(pTHX_ SV *sv)
 
     tbl = (short*)cPVOP->op_pv;
     if (!tbl)
-       Perl_croak(aTHX_ "panic: do_trans_simple");
+       Perl_croak(aTHX_ "panic: do_trans_simple line %d",__LINE__);
 
     s = (U8*)SvPV(sv, len);
     send = s + len;
@@ -92,7 +92,7 @@ S_do_trans_simple(pTHX_ SV *sv)
 }
 
 STATIC I32
-S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
+S_do_trans_count(pTHX_ SV *sv)
 {
     U8 *s;
     U8 *send;
@@ -103,7 +103,7 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 
     tbl = (short*)cPVOP->op_pv;
     if (!tbl)
-       Perl_croak(aTHX_ "panic: do_trans_count");
+       Perl_croak(aTHX_ "panic: do_trans_count line %d",__LINE__);
 
     s = (U8*)SvPV(sv, len);
     send = s + len;
@@ -130,7 +130,7 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 }
 
 STATIC I32
-S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
+S_do_trans_complex(pTHX_ SV *sv)
 {
     U8 *s;
     U8 *send;
@@ -141,13 +141,13 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
     I32 grows = PL_op->op_private & OPpTRANS_GROWS;
     I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
     I32 del = PL_op->op_private & OPpTRANS_DELETE;
-    STRLEN len, rlen;
+    STRLEN len, rlen = 0;
     short *tbl;
     I32 ch;
 
     tbl = (short*)cPVOP->op_pv;
     if (!tbl)
-       Perl_croak(aTHX_ "panic: do_trans_complex");
+       Perl_croak(aTHX_ "panic: do_trans_complex line %d",__LINE__);
 
     s = (U8*)SvPV(sv, len);
     isutf8 = SvUTF8(sv);
@@ -184,6 +184,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
                s++;
            }
        }
+       *d = '\0';
        SvCUR_set(sv, d - dstart);
     }
     else { /* isutf8 */
@@ -291,7 +292,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 }
 
 STATIC I32
-S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
+S_do_trans_simple_utf8(pTHX_ SV *sv)
 {
     U8 *s;
     U8 *send;
@@ -307,7 +308,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
     UV none = svp ? SvUV(*svp) : 0x7fffffff;
     UV extra = none + 1;
-    UV final;
+    UV final = 0;
     UV uv;
     I32 isutf8;
     U8 hibit = 0;
@@ -316,9 +317,11 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
     isutf8 = SvUTF8(sv);
     if (!isutf8) {
        U8 *t = s, *e = s + len;
-       while (t < e)
-           if ((hibit = !UTF8_IS_INVARIANT(*t++)))
+       while (t < e) {
+           U8 ch = *t++;
+           if ((hibit = !NATIVE_IS_INVARIANT(ch)))
                break;
+       }
        if (hibit)
            s = bytes_to_utf8(s, &len);
     }
@@ -341,10 +344,10 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
     }
 
     while (s < send) {
-       if ((uv = swash_fetch(rv, s)) < none) {
+       if ((uv = swash_fetch(rv, s, TRUE)) < none) {
            s += UTF8SKIP(s);
            matches++;
-           d = uvchr_to_utf8(d, uv);
+           d = uvuni_to_utf8(d, uv);
        }
        else if (uv == none) {
            int i = UTF8SKIP(s);
@@ -356,7 +359,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
            int i = UTF8SKIP(s);
            s += i;
            matches++;
-           d = uvchr_to_utf8(d, final);
+           d = uvuni_to_utf8(d, final);
        }
        else
            s += UTF8SKIP(s);
@@ -365,7 +368,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
            STRLEN clen = d - dstart;
            STRLEN nlen = dend - dstart + len + UTF8_MAXLEN;
            if (!grows)
-               Perl_croak(aTHX_ "panic: do_trans_complex_utf8");
+               Perl_croak(aTHX_ "panic: do_trans_simple_utf8 line %d",__LINE__);
            Renew(dstart, nlen+UTF8_MAXLEN, U8);
            d = dstart + clen;
            dend = dstart + nlen;
@@ -383,18 +386,15 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
     }
     SvSETMAGIC(sv);
     SvUTF8_on(sv);
-    /* Downgrading just 'cos it will is suspect - NI-S */
-    if (!isutf8 && !(PL_hints & HINT_UTF8))
-       sv_utf8_downgrade(sv, TRUE);
 
     return matches;
 }
 
 STATIC I32
-S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
+S_do_trans_count_utf8(pTHX_ SV *sv)
 {
     U8 *s;
-    U8 *start, *send;
+    U8 *start = 0, *send;
     I32 matches = 0;
     STRLEN len;
 
@@ -409,16 +409,18 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
     s = (U8*)SvPV(sv, len);
     if (!SvUTF8(sv)) {
        U8 *t = s, *e = s + len;
-       while (t < e)
-           if ((hibit = !UTF8_IS_INVARIANT(*t++)))
+       while (t < e) {
+           U8 ch = *t++;
+           if ((hibit = !NATIVE_IS_INVARIANT(ch)))
                break;
+       }
        if (hibit)
            start = s = bytes_to_utf8(s, &len);
     }
     send = s + len;
 
     while (s < send) {
-       if ((uv = swash_fetch(rv, s)) < none || uv == extra)
+       if ((uv = swash_fetch(rv, s, TRUE)) < none || uv == extra)
            matches++;
        s += UTF8SKIP(s);
     }
@@ -429,7 +431,7 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
 }
 
 STATIC I32
-S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
+S_do_trans_complex_utf8(pTHX_ SV *sv)
 {
     U8 *s;
     U8 *start, *send;
@@ -443,7 +445,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
     UV none = svp ? SvUV(*svp) : 0x7fffffff;
     UV extra = none + 1;
-    UV final;
+    UV final = 0;
     bool havefinal = FALSE;
     UV uv;
     STRLEN len;
@@ -455,9 +457,11 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     isutf8 = SvUTF8(sv);
     if (!isutf8) {
        U8 *t = s, *e = s + len;
-       while (t < e)
-           if ((hibit = !UTF8_IS_INVARIANT(*t++)))
+       while (t < e) {
+           U8 ch = *t++;
+           if ((hibit = !NATIVE_IS_INVARIANT(ch)))
                break;
+       }
        if (hibit)
            s = bytes_to_utf8(s, &len);
     }
@@ -484,13 +488,13 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     if (squash) {
        UV puv = 0xfeedface;
        while (s < send) {
-           uv = swash_fetch(rv, s);
+           uv = swash_fetch(rv, s, TRUE);
        
            if (d > dend) {
                STRLEN clen = d - dstart;
                STRLEN nlen = dend - dstart + len + UTF8_MAXLEN;
                if (!grows)
-                   Perl_croak(aTHX_ "panic: do_trans_complex_utf8");
+                   Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__);
                Renew(dstart, nlen+UTF8_MAXLEN, U8);
                d = dstart + clen;
                dend = dstart + nlen;
@@ -499,7 +503,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
                matches++;
                s += UTF8SKIP(s);
                if (uv != puv) {
-                   d = uvchr_to_utf8(d, uv);
+                   d = uvuni_to_utf8(d, uv);
                    puv = uv;
                }
                continue;
@@ -517,13 +521,13 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
                if (havefinal) {
                    s += UTF8SKIP(s);
                    if (puv != final) {
-                       d = uvchr_to_utf8(d, final);
+                       d = uvuni_to_utf8(d, final);
                        puv = final;
                    }
                }
                else {
                    STRLEN len;
-                   uv = utf8_to_uvchr(s, &len);
+                   uv = utf8_to_uvuni(s, &len);
                    if (uv != puv) {
                        Copy(s, d, len, U8);
                        d += len;
@@ -539,12 +543,12 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     }
     else {
        while (s < send) {
-           uv = swash_fetch(rv, s);
+           uv = swash_fetch(rv, s, TRUE);
            if (d > dend) {
                STRLEN clen = d - dstart;
                STRLEN nlen = dend - dstart + len + UTF8_MAXLEN;
                if (!grows)
-                   Perl_croak(aTHX_ "panic: do_trans_complex_utf8");
+                   Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__);
                Renew(dstart, nlen+UTF8_MAXLEN, U8);
                d = dstart + clen;
                dend = dstart + nlen;
@@ -552,7 +556,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
            if (uv < none) {
                matches++;
                s += UTF8SKIP(s);
-               d = uvchr_to_utf8(d, uv);
+               d = uvuni_to_utf8(d, uv);
                continue;
            }
            else if (uv == none) {      /* "none" is unmapped character */
@@ -565,7 +569,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
            else if (uv == extra && !del) {
                matches++;
                s += UTF8SKIP(s);
-               d = uvchr_to_utf8(d, final);
+               d = uvuni_to_utf8(d, final);
                continue;
            }
            matches++;                  /* "none+1" is delete character */
@@ -583,8 +587,6 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
        SvCUR_set(sv, d - dstart);
     }
     SvUTF8_on(sv);
-    if (!isutf8 && !(PL_hints & HINT_UTF8))
-       sv_utf8_downgrade(sv, TRUE);
     SvSETMAGIC(sv);
 
     return matches;
@@ -639,9 +641,11 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s
     register I32 items = sp - mark;
     register STRLEN len;
     STRLEN delimlen;
-    register char *delim = SvPV(del, delimlen);
     STRLEN tmplen;
 
+    (void) SvPV(del, delimlen); /* stringify and get the delimlen */
+    /* SvCUR assumes it's SvPOK() and woe betide you if it's not. */
+
     mark++;
     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
     (void)SvUPGRADE(sv, SVt_PV);
@@ -660,14 +664,16 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s
        ++mark;
     }
 
+    sv_setpv(sv, "");
+    if (PL_tainting && SvMAGICAL(sv))
+       SvTAINTED_off(sv);
+
     if (items-- > 0) {
-       sv_setpv(sv, "");
        if (*mark)
            sv_catsv(sv, *mark);
        mark++;
     }
-    else
-       sv_setpv(sv,"");
+
     if (delimlen) {
        for (; items > 0; items--,mark++) {
            sv_catsv(sv,del);
@@ -982,6 +988,7 @@ Perl_do_chomp(pTHX_ register SV *sv)
 {
     register I32 count;
     STRLEN len;
+    STRLEN n_a;
     char *s;
 
     if (RsSNARF(PL_rs))
@@ -1013,8 +1020,6 @@ Perl_do_chomp(pTHX_ register SV *sv)
     else if (SvREADONLY(sv))
        Perl_croak(aTHX_ PL_no_modify);
     s = SvPV(sv, len);
-    if (len && !SvPOKp(sv))
-       s = SvPV_force(sv, len);
     if (s && len) {
        s += --len;
        if (RsPARA(PL_rs)) {
@@ -1045,12 +1050,13 @@ Perl_do_chomp(pTHX_ register SV *sv)
                count += rslen;
            }
        }
-       *s = '\0';
+       s = SvPV_force(sv, n_a);
        SvCUR_set(sv, len);
+       *SvEND(sv) = '\0';
        SvNIOK_off(sv);
+       SvSETMAGIC(sv);
     }
   nope:
-    SvSETMAGIC(sv);
     return count;
 }
 
@@ -1073,7 +1079,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     char *rsave;
     bool left_utf = DO_UTF8(left);
     bool right_utf = DO_UTF8(right);
-    I32 needlen;
+    I32 needlen = 0;
 
     if (left_utf && !right_utf)
        sv_utf8_upgrade(right);
@@ -1284,7 +1290,7 @@ Perl_do_kv(pTHX)
        if (PL_op->op_flags & OPf_MOD || LVRET) {       /* lvalue */
            if (SvTYPE(TARG) < SVt_PVLV) {
                sv_upgrade(TARG, SVt_PVLV);
-               sv_magic(TARG, Nullsv, 'k', Nullch, 0);
+               sv_magic(TARG, Nullsv, PERL_MAGIC_nkeys, Nullch, 0);
            }
            LvTYPE(TARG) = 'k';
            if (LvTARG(TARG) != (SV*)keys) {
@@ -1296,7 +1302,7 @@ Perl_do_kv(pTHX)
            RETURN;
        }
 
-       if (! SvTIED_mg((SV*)keys, 'P'))
+       if (! SvTIED_mg((SV*)keys, PERL_MAGIC_tied))
            i = HvKEYS(keys);
        else {
            i = 0;