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 c411768..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
@@ -3528,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);
 
@@ -3700,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;
@@ -3806,8 +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) {
+                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++) {
@@ -3815,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)) {
@@ -4169,14 +4192,18 @@ PP(pp_fc)
     } /* Unflagged string */
     else if (len) {
         if ( IN_LOCALE_RUNTIME ) { /* Under locale */
+            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
@@ -4412,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;
@@ -4440,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);
@@ -4872,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)
@@ -5272,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) {
@@ -5621,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);