This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Reword Windows makefile comments to explain the "help" logic about USE_MULTI
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index d626df5..4ec6887 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -571,8 +571,10 @@ S_refto(pTHX_ SV *sv)
        SvTEMP_off(sv);
        SvREFCNT_inc_void_NN(sv);
     }
-    else if (SvPADTMP(sv) && !IS_PADGV(sv))
+    else if (SvPADTMP(sv)) {
+        assert(!IS_PADGV(sv));
         sv = newSVsv(sv);
+    }
     else {
        SvTEMP_off(sv);
        SvREFCNT_inc_void_NN(sv);
@@ -1024,6 +1026,7 @@ PP(pp_undef)
                 else stash = NULL;
             }
 
+           SvREFCNT_inc_simple_void_NN(sv_2mortal(sv));
            gp_free(MUTABLE_GV(sv));
            Newxz(gp, 1, GP);
            GvGP_set(sv, gp_ref(gp));
@@ -1706,10 +1709,11 @@ PP(pp_repeat)
                    SvREADONLY_on(*SP);
                }
 #else
-               if (*SP)
-                {
-                   if (mod && SvPADTMP(*SP) && !IS_PADGV(*SP))
+                if (*SP) {
+                   if (mod && SvPADTMP(*SP)) {
+                       assert(!IS_PADGV(*SP));
                        *SP = sv_mortalcopy(*SP);
+                   }
                   SvTEMP_off((*SP));
                }
 #endif
@@ -3330,7 +3334,7 @@ PP(pp_ord)
 
     XPUSHu(DO_UTF8(argsv)
            ? utf8n_to_uvchr(s, len, 0, UTF8_ALLOW_ANYUV)
-           : (UV)(*s & 0xff));
+           : (UV)(*s));
 
     RETURN;
 }
@@ -3479,7 +3483,6 @@ PP(pp_ucfirst)
     STRLEN tculen;  /* tculen is the byte length of the freshly titlecased (or
                     * lowercased) character stored in tmpbuf.  May be either
                     * UTF-8 or not, but in either case is the number of bytes */
-    bool tainted = FALSE;
 
     s = (const U8*)SvPV_const(source, slen);
 
@@ -3503,12 +3506,10 @@ PP(pp_ucfirst)
        doing_utf8 = TRUE;
         ulen = UTF8SKIP(s);
         if (op_type == OP_UCFIRST) {
-           _to_utf8_title_flags(s, tmpbuf, &tculen,
-                                cBOOL(IN_LOCALE_RUNTIME), &tainted);
+           _to_utf8_title_flags(s, tmpbuf, &tculen, IN_LOCALE_RUNTIME);
        }
         else {
-           _to_utf8_lower_flags(s, tmpbuf, &tculen,
-                                cBOOL(IN_LOCALE_RUNTIME), &tainted);
+           _to_utf8_lower_flags(s, tmpbuf, &tculen, IN_LOCALE_RUNTIME);
        }
 
         /* we can't do in-place if the length changes.  */
@@ -3531,17 +3532,27 @@ PP(pp_ucfirst)
        }
        /* is ucfirst() */
        else if (IN_LOCALE_RUNTIME) {
-           *tmpbuf = toUPPER_LC(*s);   /* This would be a bug if any locales
-                                        * have upper and title case different
-                                        */
+            if (IN_UTF8_CTYPE_LOCALE) {
+                goto do_uni_rules;
+            }
+
+            *tmpbuf = (U8) toUPPER_LC(*s); /* This would be a bug if any
+                                              locales have upper and title case
+                                              different */
        }
        else if (! IN_UNI_8_BIT) {
            *tmpbuf = toUPPER(*s);      /* Returns caseless for non-ascii, or
                                         * on EBCDIC machines whatever the
                                         * native function does */
        }
-       else { /* is ucfirst non-UTF-8, not in locale, and cased latin1 */
-           UV title_ord = _to_upper_title_latin1(*s, tmpbuf, &tculen, 's');
+        else {
+            /* Here, is ucfirst non-UTF-8, not in locale (unless that locale is
+             * UTF-8, which we treat as not in locale), and cased latin1 */
+           UV title_ord;
+
+      do_uni_rules:
+
+           title_ord = _to_upper_title_latin1(*s, tmpbuf, &tculen, 's');
            if (tculen > 1) {
                assert(tculen == 2);
 
@@ -3642,17 +3653,9 @@ PP(pp_ucfirst)
            SvCUR_set(dest, need - 1);
        }
 
-       if (tainted) {
-           TAINT;
-           SvTAINTED_on(dest);
-       }
     }
     else {  /* Neither source nor dest are in or need to be UTF-8 */
        if (slen) {
-           if (IN_LOCALE_RUNTIME) {
-               TAINT;
-               SvTAINTED_on(dest);
-           }
            if (inplace) {  /* in-place, only need to change the 1st char */
                *d = *tmpbuf;
            }
@@ -3680,6 +3683,10 @@ PP(pp_ucfirst)
            SvCUR_set(dest, need - 1);
        }
     }
+    if (IN_LOCALE_RUNTIME) {
+        TAINT;
+        SvTAINTED_on(dest);
+    }
     if (dest != source && SvTAINTED(source))
        SvTAINT(dest);
     SvSETMAGIC(dest);
@@ -3707,15 +3714,20 @@ PP(pp_uc)
        (SvTEMP(source) && !SvSMAGICAL(source) && SvREFCNT(source) == 1))
        && !SvREADONLY(source) && SvPOK(source)
        && !DO_UTF8(source)
-       && (IN_LOCALE_RUNTIME || ! IN_UNI_8_BIT)) {
-
-       /* We can convert in place.  The reason we can't if in UNI_8_BIT is to
-        * make the loop tight, so we overwrite the source with the dest before
-        * looking at it, and we need to look at the original source
-        * afterwards.  There would also need to be code added to handle
-        * switching to not in-place in midstream if we run into characters
-        * that change the length.
-        */
+       && ((IN_LOCALE_RUNTIME)
+            ? ! IN_UTF8_CTYPE_LOCALE
+            : ! IN_UNI_8_BIT))
+    {
+
+        /* We can convert in place.  The reason we can't if in UNI_8_BIT is to
+         * make the loop tight, so we overwrite the source with the dest before
+         * looking at it, and we need to look at the original source
+         * afterwards.  There would also need to be code added to handle
+         * switching to not in-place in midstream if we run into characters
+         * that change the length.  Since being in locale overrides UNI_8_BIT,
+         * that latter becomes irrelevant in the above test; instead for
+         * locale, the size can't normally change, except if the locale is a
+         * UTF-8 one */
        dest = source;
        s = d = (U8*)SvPV_force_nomg(source, len);
        min = len + 1;
@@ -3740,7 +3752,6 @@ PP(pp_uc)
     if (DO_UTF8(source)) {
        const U8 *const send = s + len;
        U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
-       bool tainted = FALSE;
 
        /* All occurrences of these are to be moved to follow any other marks.
         * This is context-dependent.  We may not be passed enough context to
@@ -3770,8 +3781,7 @@ PP(pp_uc)
              * and copy it to the output buffer */
 
             u = UTF8SKIP(s);
-            uv = _to_utf8_upper_flags(s, tmpbuf, &ulen,
-                                     cBOOL(IN_LOCALE_RUNTIME), &tainted);
+            uv = _to_utf8_upper_flags(s, tmpbuf, &ulen, IN_LOCALE_RUNTIME);
 #define GREEK_CAPITAL_LETTER_IOTA 0x0399
 #define COMBINING_GREEK_YPOGEGRAMMENI 0x0345
             if (uv == GREEK_CAPITAL_LETTER_IOTA
@@ -3806,10 +3816,6 @@ PP(pp_uc)
        *d = '\0';
 
        SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
-       if (tainted) {
-           TAINT;
-           SvTAINTED_on(dest);
-       }
     }
     else {     /* Not UTF-8 */
        if (len) {
@@ -3819,10 +3825,11 @@ PP(pp_uc)
             * latin1 as having case; otherwise the latin1 casing.  Do the
             * whole thing in a tight loop, for speed, */
            if (IN_LOCALE_RUNTIME) {
-               TAINT;
-               SvTAINTED_on(dest);
+                if (IN_UTF8_CTYPE_LOCALE) {
+                    goto do_uni_rules;
+                }
                for (; s < send; d++, s++)
-                   *d = toUPPER_LC(*s);
+                    *d = (U8) toUPPER_LC(*s);
            }
            else if (! IN_UNI_8_BIT) {
                for (; s < send; d++, s++) {
@@ -3830,6 +3837,7 @@ PP(pp_uc)
                }
            }
            else {
+          do_uni_rules:
                for (; s < send; d++, s++) {
                    *d = toUPPER_LATIN1_MOD(*s);
                    if (LIKELY(*d != LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) {
@@ -3918,6 +3926,10 @@ PP(pp_uc)
            SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
        }
     } /* End of isn't utf8 */
+    if (IN_LOCALE_RUNTIME) {
+        TAINT;
+        SvTAINTED_on(dest);
+    }
     if (dest != source && SvTAINTED(source))
        SvTAINT(dest);
     SvSETMAGIC(dest);
@@ -3970,14 +3982,12 @@ PP(pp_lc)
     if (DO_UTF8(source)) {
        const U8 *const send = s + len;
        U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
-       bool tainted = FALSE;
 
        while (s < send) {
            const STRLEN u = UTF8SKIP(s);
            STRLEN ulen;
 
-           _to_utf8_lower_flags(s, tmpbuf, &ulen,
-                                cBOOL(IN_LOCALE_RUNTIME), &tainted);
+           _to_utf8_lower_flags(s, tmpbuf, &ulen, IN_LOCALE_RUNTIME);
 
            /* Here is where we would do context-sensitive actions.  See the
             * commit message for 86510fb15 for why there isn't any */
@@ -4007,10 +4017,6 @@ PP(pp_lc)
        SvUTF8_on(dest);
        *d = '\0';
        SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
-       if (tainted) {
-           TAINT;
-           SvTAINTED_on(dest);
-       }
     } else {   /* Not utf8 */
        if (len) {
            const U8 *const send = s + len;
@@ -4018,12 +4024,10 @@ PP(pp_lc)
            /* Use locale casing if in locale; regular style if not treating
             * latin1 as having case; otherwise the latin1 casing.  Do the
             * whole thing in a tight loop, for speed, */
-           if (IN_LOCALE_RUNTIME) {
-               TAINT;
-               SvTAINTED_on(dest);
+            if (IN_LOCALE_RUNTIME) {
                for (; s < send; d++, s++)
                    *d = toLOWER_LC(*s);
-           }
+            }
            else if (! IN_UNI_8_BIT) {
                for (; s < send; d++, s++) {
                    *d = toLOWER(*s);
@@ -4040,6 +4044,10 @@ PP(pp_lc)
            SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
        }
     }
+    if (IN_LOCALE_RUNTIME) {
+        TAINT;
+        SvTAINTED_on(dest);
+    }
     if (dest != source && SvTAINTED(source))
        SvTAINT(dest);
     SvSETMAGIC(dest);
@@ -4164,12 +4172,11 @@ PP(pp_fc)
 
     send = s + len;
     if (DO_UTF8(source)) { /* UTF-8 flagged string. */
-        bool tainted = FALSE;
         while (s < send) {
             const STRLEN u = UTF8SKIP(s);
             STRLEN ulen;
 
-            _to_utf8_fold_flags(s, tmpbuf, &ulen, flags, &tainted);
+            _to_utf8_fold_flags(s, tmpbuf, &ulen, flags);
 
             if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
                 const UV o = d - (U8*)SvPVX_const(dest);
@@ -4182,23 +4189,21 @@ PP(pp_fc)
             s += u;
         }
         SvUTF8_on(dest);
-       if (tainted) {
-           TAINT;
-           SvTAINTED_on(dest);
-       }
     } /* Unflagged string */
     else if (len) {
         if ( IN_LOCALE_RUNTIME ) { /* Under locale */
-            TAINT;
-            SvTAINTED_on(dest);
+            if (IN_UTF8_CTYPE_LOCALE) {
+                goto do_uni_folding;
+            }
             for (; s < send; d++, s++)
-                *d = toFOLD_LC(*s);
+                *d = (U8) toFOLD_LC(*s);
         }
         else if ( !IN_UNI_8_BIT ) { /* Under nothing, or bytes */
             for (; s < send; d++, s++)
                 *d = toFOLD(*s);
         }
         else {
+      do_uni_folding:
             /* For ASCII and the Latin-1 range, there's only two troublesome
              * folds, \x{DF} (\N{LATIN SMALL LETTER SHARP S}), which under full
              * casefolding becomes 'ss'; and \x{B5} (\N{MICRO SIGN}), which
@@ -4265,6 +4270,10 @@ PP(pp_fc)
     *d = '\0';
     SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
 
+    if (IN_LOCALE_RUNTIME) {
+        TAINT;
+        SvTAINTED_on(dest);
+    }
     if (SvTAINTED(source))
        SvTAINT(dest);
     SvSETMAGIC(dest);
@@ -4430,7 +4439,7 @@ PP(pp_aeach)
     IV *iterp = Perl_av_iter_p(aTHX_ array);
     const IV current = (*iterp)++;
 
-    if (current > av_len(array)) {
+    if (current > av_tindex(array)) {
        *iterp = 0;
        if (gimme == G_SCALAR)
            RETPUSHUNDEF;
@@ -4458,7 +4467,7 @@ PP(pp_akeys)
 
     if (gimme == G_SCALAR) {
        dTARGET;
-       PUSHi(av_len(array) + 1);
+       PUSHi(av_tindex(array) + 1);
     }
     else if (gimme == G_ARRAY) {
         IV n = Perl_av_len(aTHX_ array);
@@ -4890,8 +4899,10 @@ PP(pp_lslice)
            is_something_there = TRUE;
            if (!(*lelem = firstrelem[ix]))
                *lelem = &PL_sv_undef;
-           else if (mod && SvPADTMP(*lelem) && !IS_PADGV(*lelem))
+           else if (mod && SvPADTMP(*lelem)) {
+                assert(!IS_PADGV(*lelem));
                *lelem = firstrelem[ix] = sv_mortalcopy(*lelem);
+            }
        }
     }
     if (is_something_there)
@@ -5290,7 +5301,7 @@ PP(pp_reverse)
                const MAGIC *mg;
                bool can_preserve = SvCANEXISTDELETE(av);
 
-               for (i = 0, j = av_len(av); i < j; ++i, --j) {
+               for (i = 0, j = av_tindex(av); i < j; ++i, --j) {
                    SV *begin, *end;
 
                    if (can_preserve) {
@@ -5639,7 +5650,7 @@ PP(pp_split)
     else if (do_utf8 == (RX_UTF8(rx) != 0) &&
             (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) && !RX_NPARENS(rx)
             && (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
-            && !(RX_EXTFLAGS(rx) & RXf_ANCH)) {
+             && !(RX_EXTFLAGS(rx) & RXf_IS_ANCHORED)) {
        const int tail = (RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL);
        SV * const csv = CALLREG_INTUIT_STRING(rx);