This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regexec.c: Add another place to not re-fold
[perl5.git] / regexec.c
index 93de2cf..6f47ae9 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -80,7 +80,7 @@
 #  include "regcomp.h"
 #endif
 
-#define RF_tainted     1               /* tainted information used? */
+#define RF_tainted     1       /* tainted information used? e.g. locale */
 #define RF_warned      2               /* warned about big count? */
 
 #define RF_utf8                8               /* Pattern contains multibyte chars? */
 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 
 /* these are unrolled below in the CCC_TRY_XXX defined */
-#define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
-    if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END
+#ifdef EBCDIC
+    /* Often 'str' is a hard-coded utf8 string instead of utfebcdic. so just
+     * skip the check on EBCDIC platforms */
+#   define LOAD_UTF8_CHARCLASS(class,str) LOAD_UTF8_CHARCLASS_NO_CHECK(class)
+#else
+#   define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
+    if (!CAT2(PL_utf8_,class)) { \
+       bool ok; \
+       ENTER; save_re_context(); \
+       ok=CAT2(is_utf8_,class)((const U8*)str); \
+       assert(ok); assert(CAT2(PL_utf8_,class)); LEAVE; } } STMT_END
+#endif
 
 /* Doesn't do an assert to verify that is correct */
 #define LOAD_UTF8_CHARCLASS_NO_CHECK(class) STMT_START { \
-    if (!CAT2(PL_utf8_,class)) { bool throw_away; ENTER; save_re_context(); throw_away = CAT2(is_utf8_,class)((const U8*)" "); LEAVE; } } STMT_END
+    if (!CAT2(PL_utf8_,class)) { \
+       bool throw_away __attribute__unused__; \
+       ENTER; save_re_context(); \
+       throw_away = CAT2(is_utf8_,class)((const U8*)" "); \
+       LEAVE; } } STMT_END
 
 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
        LOAD_UTF8_CHARCLASS_NO_CHECK(X_T);      /* U+11A8 "\xe1\x86\xa8" */ \
        LOAD_UTF8_CHARCLASS_NO_CHECK(X_V)       /* U+1160 "\xe1\x85\xa0" */  
 
-/* 
-   We dont use PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS as the direct test
-   so that it is possible to override the option here without having to 
-   rebuild the entire core. as we are required to do if we change regcomp.h
-   which is where PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS is defined.
-*/
-#if PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS
-#define BROKEN_UNICODE_CHARCLASS_MAPPINGS
-#endif
-
-#ifdef BROKEN_UNICODE_CHARCLASS_MAPPINGS
-#define LOAD_UTF8_CHARCLASS_PERL_WORD()   LOAD_UTF8_CHARCLASS_ALNUM()
-#define LOAD_UTF8_CHARCLASS_PERL_SPACE()  LOAD_UTF8_CHARCLASS_SPACE()
-#define LOAD_UTF8_CHARCLASS_POSIX_DIGIT() LOAD_UTF8_CHARCLASS_DIGIT()
-#define RE_utf8_perl_word   PL_utf8_alnum
-#define RE_utf8_perl_space  PL_utf8_space
-#define RE_utf8_posix_digit PL_utf8_digit
-#define perl_word  alnum
-#define perl_space space
-#define posix_digit digit
-#else
-#define LOAD_UTF8_CHARCLASS_PERL_WORD()   LOAD_UTF8_CHARCLASS(perl_word,"a")
-#define LOAD_UTF8_CHARCLASS_PERL_SPACE()  LOAD_UTF8_CHARCLASS(perl_space," ")
-#define LOAD_UTF8_CHARCLASS_POSIX_DIGIT() LOAD_UTF8_CHARCLASS(posix_digit,"0")
-#define RE_utf8_perl_word   PL_utf8_perl_word
-#define RE_utf8_perl_space  PL_utf8_perl_space
-#define RE_utf8_posix_digit PL_utf8_posix_digit
-#endif
-
 #define PLACEHOLDER    /* Something for the preprocessor to grab onto */
 
 /* The actual code for CCC_TRY, which uses several variables from the routine
@@ -713,11 +698,26 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
             (IV)prog->check_end_shift);
     });       
         
-    if (flags & REXEC_SCREAM) {
+    if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) {
        I32 p = -1;                     /* Internal iterator of scream. */
        I32 * const pp = data ? data->scream_pos : &p;
+       const MAGIC *mg;
+       bool found = FALSE;
+
+       assert(SvMAGICAL(sv));
+       mg = mg_find(sv, PERL_MAGIC_study);
+       assert(mg);
 
-       if (PL_screamfirst[BmRARE(check)] >= 0
+       if (mg->mg_private == 1) {
+           found = ((U8 *)mg->mg_ptr)[BmRARE(check)] != (U8)~0;
+       } else if (mg->mg_private == 2) {
+           found = ((U16 *)mg->mg_ptr)[BmRARE(check)] != (U16)~0;
+       } else {
+           assert (mg->mg_private == 4);
+           found = ((U32 *)mg->mg_ptr)[BmRARE(check)] != (U32)~0;
+       }
+
+       if (found
            || ( BmRARE(check) == '\n'
                 && (BmPREVIOUS(check) == SvCUR(check) - 1)
                 && SvTAIL(check) ))
@@ -1442,23 +1442,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
                           reginclass(prog, c, (U8*)s, &inclasslen, utf8_target));
            }
            else {
-                while (s < strend) {
-                     STRLEN skip = 1;
-
-                     if (REGINCLASS(prog, c, (U8*)s) ||
-                         (ANYOF_FOLD_SHARP_S(c, s, strend) &&
-                          /* The assignment of 2 is intentional:
-                           * for the folded sharp s, the skip is 2. */
-                          (skip = SHARP_S_SKIP))) {
-                          if (tmp && (!reginfo || regtry(reginfo, &s)))
-                               goto got_it;
-                          else
-                               tmp = doevery;
-                     }
-                     else 
-                          tmp = 1;
-                     s += skip;
-                }
+               REXEC_FBC_CLASS_SCAN(REGINCLASS(prog, c, (U8*)s));
            }
            break;
        case CANY:
@@ -1479,23 +1463,11 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            folder = foldEQ_latin1;         /* /a, except the sharp s one which */
            goto do_exactf_non_utf8;        /* isn't dealt with by these */
 
-       case EXACTFU:
-           if (UTF_PATTERN || utf8_target) {
-               utf8_fold_flags = 0;
-               goto do_exactf_utf8;
-           }
-           fold_array = PL_fold_latin1;
-           folder = foldEQ_latin1;
-           /* XXX This uses the full utf8 fold because if the pattern contains
-            * 'ss' it could match LATIN_SMALL_LETTER SHARP_S in the string.
-            * There could be a new node type, say EXACTFU_SS, which is
-            * generated by regcomp only if there is an 'ss', and then every
-            * other case could goto do_exactf_non_utf8;*/
-           goto do_exactf_utf8;
-
        case EXACTF:
            if (UTF_PATTERN || utf8_target) {
-               utf8_fold_flags = 0;
+
+               /* regcomp.c already folded this if pattern is in UTF-8 */
+               utf8_fold_flags = (UTF_PATTERN) ? FOLDEQ_S2_ALREADY_FOLDED : 0;
                goto do_exactf_utf8;
            }
            fold_array = PL_fold;
@@ -1504,11 +1476,24 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 
        case EXACTFL:
            if (UTF_PATTERN || utf8_target) {
-               utf8_fold_flags = 0; /* XXX, add new flag for locale */
+               utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
                goto do_exactf_utf8;
            }
            fold_array = PL_fold_locale;
            folder = foldEQ_locale;
+           goto do_exactf_non_utf8;
+
+       case EXACTFU:
+           if (UTF_PATTERN || utf8_target) {
+               utf8_fold_flags = (UTF_PATTERN) ? FOLDEQ_S2_ALREADY_FOLDED : 0;
+               goto do_exactf_utf8;
+           }
+
+           /* Any 'ss' in the pattern should have been replaced by regcomp,
+            * so we don't have to worry here about this single special case
+            * in the Latin1 range */
+           fold_array = PL_fold_latin1;
+           folder = foldEQ_latin1;
 
            /* FALL THROUGH */
 
@@ -1523,6 +1508,11 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            pat_string = STRING(c);
            ln  = STR_LEN(c);   /* length to match in octets/bytes */
 
+           /* We know that we have to match at least 'ln' bytes (which is the
+            * same as characters, since not utf8).  If we have to match 3
+            * characters, and there are only 2 availabe, we know without
+            * trying that it will fail; so don't start a match past the
+            * required minimum number from the far end */
            e = HOP3c(strend, -((I32)ln), s);
 
            if (!reginfo && e < s) {
@@ -1540,6 +1530,9 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            break;
 
        do_exactf_utf8:
+       {
+           unsigned expansion;
+
 
            /* If one of the operands is in utf8, we can't use the simpler
             * folding above, due to the fact that many different characters
@@ -1552,12 +1545,33 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
                    ? utf8_length((U8 *) pat_string, (U8 *) pat_end)
                    : ln;
 
+           /* We have 'lnc' characters to match in the pattern, but because of
+            * multi-character folding, each character in the target can match
+            * up to 3 characters (Unicode guarantees it will never exceed
+            * this) if it is utf8-encoded; and up to 2 if not (based on the
+            * fact that the Latin 1 folds are already determined, and the
+            * only multi-char fold in that range is the sharp-s folding to
+            * 'ss'.  Thus, a pattern character can match as little as 1/3 of a
+            * string character.  Adjust lnc accordingly, always matching at
+            * least 1 */
+           expansion = (utf8_target) ? UTF8_MAX_FOLD_CHAR_EXPAND : 2;
+           lnc = (lnc < expansion) ? 1 : lnc / expansion;
+
+           /* As in the non-UTF8 case, if we have to match 3 characters, and
+            * only 2 are left, it's guaranteed to fail, so don't start a
+            * match that would require us to go beyond the end of the string
+            */
            e = HOP3c(strend, -((I32)lnc), s);
 
            if (!reginfo && e < s) {
                e = s;                  /* Due to minlen logic of intuit() */
            }
 
+           /* XXX Note that we could recalculate e every so-often through the
+            * loop to stop earlier, as the worst case expansion above will
+            * rarely be met, and as we go along we would usually find that e
+            * moves further to the left.  Unclear if worth the expense */
+
            while (s <= e) {
                char *my_strend= (char *)strend;
                if (foldEQ_utf8_flags(s, &my_strend, 0,  utf8_target,
@@ -1569,6 +1583,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
                s += UTF8SKIP(s);
            }
            break;
+       }
        case BOUNDL:
            PL_reg_flags |= RF_tainted;
            FBC_BOUND(isALNUM_LC,
@@ -1619,15 +1634,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            break;
        case ALNUMU:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_PERL_WORD(),
-               swash_fetch(RE_utf8_perl_word,(U8*)s, utf8_target),
+               LOAD_UTF8_CHARCLASS_ALNUM(),
+               swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
                 isWORDCHAR_L1((U8) *s)
            );
            break;
        case ALNUM:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_PERL_WORD(),
-               swash_fetch(RE_utf8_perl_word,(U8*)s, utf8_target),
+               LOAD_UTF8_CHARCLASS_ALNUM(),
+               swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
                 isWORDCHAR((U8) *s)
            );
            break;
@@ -1638,15 +1653,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            break;
        case NALNUMU:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_PERL_WORD(),
-               swash_fetch(RE_utf8_perl_word,(U8*)s, utf8_target),
+               LOAD_UTF8_CHARCLASS_ALNUM(),
+               !swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
                 ! isWORDCHAR_L1((U8) *s)
            );
            break;
        case NALNUM:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_PERL_WORD(),
-               !swash_fetch(RE_utf8_perl_word, (U8*)s, utf8_target),
+               LOAD_UTF8_CHARCLASS_ALNUM(),
+               !swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target),
                 ! isALNUM(*s)
            );
            break;
@@ -1664,15 +1679,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            break;
        case SPACEU:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_PERL_SPACE(),
-               *s == ' ' || swash_fetch(RE_utf8_perl_space,(U8*)s, utf8_target),
+               LOAD_UTF8_CHARCLASS_SPACE(),
+               *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target),
                 isSPACE_L1((U8) *s)
            );
            break;
        case SPACE:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_PERL_SPACE(),
-               *s == ' ' || swash_fetch(RE_utf8_perl_space,(U8*)s, utf8_target),
+               LOAD_UTF8_CHARCLASS_SPACE(),
+               *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target),
                 isSPACE((U8) *s)
            );
            break;
@@ -1689,15 +1704,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            break;
        case NSPACEU:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_PERL_SPACE(),
-               !( *s == ' ' || swash_fetch(RE_utf8_perl_space,(U8*)s, utf8_target)),
+               LOAD_UTF8_CHARCLASS_SPACE(),
+               !( *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target)),
                 ! isSPACE_L1((U8) *s)
            );
            break;
        case NSPACE:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_PERL_SPACE(),
-               !(*s == ' ' || swash_fetch(RE_utf8_perl_space,(U8*)s, utf8_target)),
+               LOAD_UTF8_CHARCLASS_SPACE(),
+               !(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target)),
                 ! isSPACE((U8) *s)
            );
            break;
@@ -1715,8 +1730,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            break;
        case DIGIT:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_POSIX_DIGIT(),
-               swash_fetch(RE_utf8_posix_digit,(U8*)s, utf8_target),
+               LOAD_UTF8_CHARCLASS_DIGIT(),
+               swash_fetch(PL_utf8_digit,(U8*)s, utf8_target),
                isDIGIT(*s)
            );
            break;
@@ -1733,8 +1748,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            break;
        case NDIGIT:
            REXEC_FBC_CSCAN_PRELOAD(
-               LOAD_UTF8_CHARCLASS_POSIX_DIGIT(),
-               !swash_fetch(RE_utf8_posix_digit,(U8*)s, utf8_target),
+               LOAD_UTF8_CHARCLASS_DIGIT(),
+               !swash_fetch(PL_utf8_digit,(U8*)s, utf8_target),
                !isDIGIT(*s)
            );
            break;
@@ -2327,7 +2342,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
        dontbother = end_shift;
        strend = HOPc(strend, -dontbother);
        while ( (s <= last) &&
-               ((flags & REXEC_SCREAM)
+               ((flags & REXEC_SCREAM) && SvSCREAM(sv)
                 ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg,
                                    end_shift, &scream_pos, 0))
                 : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
@@ -2406,7 +2421,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
                utf8_target ? to_utf8_substr(prog) : to_byte_substr(prog);
            float_real = utf8_target ? prog->float_utf8 : prog->float_substr;
 
-           if (flags & REXEC_SCREAM) {
+           if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) {
                last = screaminstr(sv, float_real, s - strbeg,
                                   end_shift, &scream_pos, 1); /* last one */
                if (!last)
@@ -2600,7 +2615,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
        /* This is safe against NULLs: */
        ReREFCNT_dec(PM_GETRE(PL_reg_curpm));
        /* PM_reg_curpm owns a reference to this regexp.  */
-       ReREFCNT_inc(rx);
+       (void)ReREFCNT_inc(rx);
 #endif
        PM_SETRE(PL_reg_curpm, rx);
        PL_reg_oldcurpm = PL_curpm;
@@ -3640,25 +3655,25 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            PL_reg_flags |= RF_tainted;
            folder = foldEQ_locale;
            fold_array = PL_fold_locale;
-           fold_utf8_flags = 0;
+           fold_utf8_flags = FOLDEQ_UTF8_LOCALE;
            goto do_exactf;
 
        case EXACTFU:
            folder = foldEQ_latin1;
            fold_array = PL_fold_latin1;
-           fold_utf8_flags = 0;
+           fold_utf8_flags = (UTF_PATTERN) ? FOLDEQ_S1_ALREADY_FOLDED : 0;
            goto do_exactf;
 
        case EXACTFA:
            folder = foldEQ_latin1;
            fold_array = PL_fold_latin1;
-           fold_utf8_flags = 1;
+           fold_utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII;
            goto do_exactf;
 
        case EXACTF:
            folder = foldEQ;
            fold_array = PL_fold;
-           fold_utf8_flags = 0;
+           fold_utf8_flags = (UTF_PATTERN) ? FOLDEQ_S1_ALREADY_FOLDED : 0;
 
          do_exactf:
            s = STRING(scan);
@@ -3670,20 +3685,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                char *e = PL_regeol;
 
                if (! foldEQ_utf8_flags(s, 0,  ln, cBOOL(UTF_PATTERN),
-                              l, &e, 0,  utf8_target, fold_utf8_flags)) {
-                    /* One more case for the sharp s:
-                     * pack("U0U*", 0xDF) =~ /ss/i,
-                     * the 0xC3 0x9F are the UTF-8
-                     * byte sequence for the U+00DF. */
-
-                    if (!(utf8_target &&
-                          toLOWER(s[0]) == 's' &&
-                          ln >= 2 &&
-                          toLOWER(s[1]) == 's' &&
-                          (U8)l[0] == 0xC3 &&
-                          e - l >= 2 &&
-                          (U8)l[1] == 0x9F))
-                         sayNO;
+                              l, &e, 0,  utf8_target, fold_utf8_flags))
+               {
+                   sayNO;
                }
                locinput = e;
                nextchr = UCHARAT(locinput);
@@ -3719,7 +3723,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
        case NBOUNDU:
        case NBOUNDA:
            /* was last char in word? */
-           if (utf8_target && FLAGS(scan) != REGEX_ASCII_RESTRICTED_CHARSET) {
+           if (utf8_target
+               && FLAGS(scan) != REGEX_ASCII_RESTRICTED_CHARSET
+               && FLAGS(scan) != REGEX_ASCII_MORE_RESTRICTED_CHARSET)
+           {
                if (locinput == PL_bostr)
                    ln = '\n';
                else {
@@ -3766,6 +3773,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                        n = isALNUM(nextchr);
                        break;
                    case REGEX_ASCII_RESTRICTED_CHARSET:
+                   case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
                        ln = isWORDCHAR_A(ln);
                        n = isWORDCHAR_A(nextchr);
                        break;
@@ -3808,18 +3816,18 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                  ALNUML, NALNUML, isALNUM_LC, isALNUM_LC_utf8,
                  ALNUMU, NALNUMU, isWORDCHAR_L1,
                  ALNUMA, NALNUMA, isWORDCHAR_A,
-                 perl_word, "a");
+                 alnum, "a");
 
         CCC_TRY_U(SPACE,  NSPACE,  isSPACE,
                  SPACEL, NSPACEL, isSPACE_LC, isSPACE_LC_utf8,
                  SPACEU, NSPACEU, isSPACE_L1,
                  SPACEA, NSPACEA, isSPACE_A,
-                 perl_space, " ");
+                 space, " ");
 
         CCC_TRY(DIGIT,  NDIGIT,  isDIGIT,
                DIGITL, NDIGITL, isDIGIT_LC, isDIGIT_LC_utf8,
                DIGITA, NDIGITA, isDIGIT_A,
-               posix_digit, "0");
+               digit, "0");
 
        case CLUMP: /* Match \X: logical Unicode character.  This is defined as
                       a Unicode extended Grapheme Cluster */
@@ -3865,17 +3873,17 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                   L* (L | LVT T* | V  V* T* | LV  V* T*)
 
               That means that if we have seen any L's at all we can quit
-              there, but if the next character is a LVT, a V or and LV we
+              there, but if the next character is an LVT, a V, or an LV we
               should keep going.
 
               There is a subtlety with Prepend* which showed up in testing.
               Note that the Begin, and only the Begin is required in:
                | Prepend* Begin Extend*
-              Also, Begin contains '! Control'.  A Prepend must be a '!
-              Control', which means it must be a Begin.  What it comes down to
-              is that if we match Prepend* and then find no suitable Begin
-              afterwards, that if we backtrack the last Prepend, that one will
-              be a suitable Begin.
+              Also, Begin contains '! Control'.  A Prepend must be a
+              '!  Control', which means it must also be a Begin.  What it
+              comes down to is that if we match Prepend* and then find no
+              suitable Begin afterwards, that if we backtrack the last
+              Prepend, that one will be a suitable Begin.
            */
 
            if (locinput >= PL_regeol)
@@ -3885,7 +3893,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                /* Match either CR LF  or '.', as all the other possibilities
                 * require utf8 */
                locinput++;         /* Match the . or CR */
-               if (nextchr == '\r'
+               if (nextchr == '\r' /* And if it was CR, and the next is LF,
+                                      match the LF */
                    && locinput < PL_regeol
                    && UCHARAT(locinput) == '\n') locinput++;
            }
@@ -4051,7 +4060,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            folder = foldEQ_locale;
            fold_array = PL_fold_locale;
            type = REFFL;
-           utf8_fold_flags = 0;
+           utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
            goto do_nref;
 
        case NREFFA:
@@ -4095,7 +4104,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
            PL_reg_flags |= RF_tainted;
            folder = foldEQ_locale;
            fold_array = PL_fold_locale;
-           utf8_fold_flags = 0;
+           utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
            goto do_ref;
 
        case REFFA:
@@ -4247,6 +4256,12 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                PL_op = (OP_4tree*)rexi->data->data[n];
                DEBUG_STATE_r( PerlIO_printf(Perl_debug_log, 
                    "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
+               /* wrap the call in two SAVECOMPPADs. This ensures that
+                * when the save stack is eventually unwound, all the
+                * accumulated SAVEt_CLEARSV's will be processed with
+                * interspersed SAVEt_COMPPAD's to ensure that lexicals
+                * are cleared in the right pad */
+               SAVECOMPPAD();
                PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]);
                PL_regoffs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr;
 
@@ -4267,6 +4282,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                Copy(&saved_state, &PL_reg_state, 1, struct re_save_state);
 
                PL_op = oop;
+               SAVECOMPPAD();
                PAD_RESTORE_LOCAL(old_comppad);
                PL_curcop = ocurcop;
                PL_regeol = saved_regeol;
@@ -4693,7 +4709,10 @@ NULL
            /* First just match a string of min A's. */
 
            if (n < min) {
+               ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
                cur_curlyx->u.curlyx.lastloc = locinput;
+               REGCP_SET(ST.lastcp);
+
                PUSH_STATE_GOTO(WHILEM_A_pre, A);
                /* NOTREACHED */
            }
@@ -4799,10 +4818,10 @@ NULL
            /* NOTREACHED */
 
        case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
-           REGCP_UNWIND(ST.lastcp);
-           regcppop(rex);
            /* FALL THROUGH */
        case WHILEM_A_pre_fail: /* just failed to match even minimal A */
+           REGCP_UNWIND(ST.lastcp);
+           regcppop(rex);
            cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
            cur_curlyx->u.curlyx.count--;
            CACHEsayNO;
@@ -5454,7 +5473,7 @@ NULL
                rex = (struct regexp *)SvANY(rex_sv);
                rexi = RXi_GET(rex);
                cur_curlyx = cur_eval->u.eval.prev_curlyx;
-               ReREFCNT_inc(rex_sv);
+               (void)ReREFCNT_inc(rex_sv);
                st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
 
                /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
@@ -5702,6 +5721,8 @@ NULL
 
 #define CASE_CLASS(nAmE)                              \
         case nAmE:                                    \
+           if (locinput >= PL_regeol)                \
+               sayNO;                                \
             if ((n=is_##nAmE(locinput,utf8_target))) {    \
                 locinput += n;                        \
                 nextchr = UCHARAT(locinput);          \
@@ -5709,6 +5730,8 @@ NULL
                 sayNO;                                \
             break;                                    \
         case N##nAmE:                                 \
+           if (locinput >= PL_regeol)                \
+               sayNO;                                \
             if ((n=is_##nAmE(locinput,utf8_target))) {    \
                 sayNO;                                \
             } else {                                  \
@@ -6005,10 +6028,12 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
 
     case EXACTFL:
        PL_reg_flags |= RF_tainted;
-       /* FALL THROUGH */
+       utf8_flags = FOLDEQ_UTF8_LOCALE;
+       goto do_exactf;
+
     case EXACTF:
     case EXACTFU:
-       utf8_flags = 0;
+       utf8_flags = (UTF_PATTERN) ? FOLDEQ_S2_ALREADY_FOLDED : 0;
 
        /* The comments for the EXACT case above apply as well to these fold
         * ones */
@@ -6018,11 +6043,6 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
        assert(! UTF_PATTERN || UNI_IS_INVARIANT(c));
 
        if (utf8_target) { /* Use full Unicode fold matching */
-
-           /* For the EXACTFL case, It doesn't really make sense to compare
-            * locale and utf8, but it is best we can do.  The documents warn
-            * against mixing them */
-
            char *tmpeol = loceol;
            while (hardcount < max
                    && foldEQ_utf8_flags(scan, &tmpeol, 0, utf8_target,
@@ -6468,6 +6488,8 @@ Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool
 
     PERL_ARGS_ASSERT_REGCLASS_SWASH;
 
+    assert(ANYOF_NONBITMAP(node));
+
     if (data && data->count) {
        const U32 n = ARG(node);
 
@@ -6621,13 +6643,24 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n,
     }
 
     /* If the bitmap didn't (or couldn't) match, and something outside the
-     * bitmap could match, try that */
+     * bitmap could match, try that.  Locale nodes specifiy completely the
+     * behavior of code points in the bit map (otherwise, a utf8 target would
+     * cause them to be treated as Unicode and not locale), except in
+     * the very unlikely event when this node is a synthetic start class, which
+     * could be a combination of locale and non-locale nodes.  So allow locale
+     * to match for the synthetic start class, which will give a false
+     * positive that will be resolved when the match is done again as not part
+     * of the synthetic start class */
     if (!match) {
        if (utf8_target && (flags & ANYOF_UNICODE_ALL) && c >= 256) {
            match = TRUE;       /* Everything above 255 matches */
        }
-       else if ((flags & ANYOF_NONBITMAP_NON_UTF8
-                 || (utf8_target && flags & ANYOF_UTF8)))
+       else if (ANYOF_NONBITMAP(n)
+                && ((flags & ANYOF_NONBITMAP_NON_UTF8)
+                    || (utf8_target
+                        && (c >=256
+                            || (! (flags & ANYOF_LOCALE))
+                            || (flags & ANYOF_IS_SYNTHETIC)))))
        {
            AV *av;
            SV * const sw = regclass_swash(prog, n, TRUE, 0, (SV**)&av);
@@ -6660,31 +6693,19 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n,
                else if (flags & ANYOF_LOC_NONBITMAP_FOLD) {
 
                    /* Here, we need to test if the fold of the target string
-                    * matches.  In the case of a multi-char fold that is
-                    * caught by regcomp.c, it has stored all such folds into
-                    * 'av'; we linearly check to see if any match the target
-                    * string (folded).   We know that the originals were each
-                    * one character, but we don't currently know how many
-                    * characters/bytes each folded to, except we do know that
-                    * there are small limits imposed by Unicode.  XXX A
-                    * performance enhancement would be to have regcomp.c store
-                    * the max number of chars/bytes that are in an av entry,
-                    * as, say the 0th element.  Even better would be to have a
-                    * hash of the few characters that can start a multi-char
-                    * fold to the max number of chars of those folds.
-                    *
-                    * Further down, if there isn't a
-                    * match in the av, we will check if there is another
-                    * fold-type match.  For that, we also need the fold, but
-                    * only the first character.  No sense in folding it twice,
-                    * so we do it here, even if there isn't any multi-char
-                    * fold, so we always fold at least the first character.
-                    * If the node is a straight ANYOF node, or there is only
-                    * one character available in the string, or if there isn't
-                    * any av, that's all we have to fold.  In the case of a
-                    * multi-char fold, we do have guarantees in Unicode that
-                    * it can only expand up to so many characters and so many
-                    * bytes.  We keep track so don't exceed either.
+                    * matches.  The non-multi char folds have all been moved to
+                     * the compilation phase, and the multi-char folds have
+                     * been stored by regcomp into 'av'; we linearly check to
+                     * see if any match the target string (folded).   We know
+                     * that the originals were each one character, but we don't
+                     * currently know how many characters/bytes each folded to,
+                     * except we do know that there are small limits imposed by
+                     * Unicode.  XXX A performance enhancement would be to have
+                     * regcomp.c store the max number of chars/bytes that are
+                     * in an av entry, as, say the 0th element.  Even better
+                     * would be to have a hash of the few characters that can
+                     * start a multi-char fold to the max number of chars of
+                     * those folds.
                     *
                     * If there is a match, we will need to advance (if lenp is
                     * specified) the match pointer in the target string.  But
@@ -6694,28 +6715,34 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n,
                     * create a map so that we know how many bytes in the
                     * source to advance given that we have matched a certain
                     * number of bytes in the fold.  This map is stored in
-                    * 'map_fold_len_back'.  The first character in the fold
-                    * has array element 1 contain the number of bytes in the
-                    * source that folded to it; the 2nd is the cumulative
-                    * number to match it; ... */
-                   U8 map_fold_len_back[UTF8_MAX_FOLD_CHAR_EXPAND] = { 0 };
+                    * 'map_fold_len_back'.  Let n mean the number of bytes in
+                    * the fold of the first character that we are folding.
+                    * Then map_fold_len_back[n] is set to the number of bytes
+                    * in that first character.  Similarly let m be the
+                    * corresponding number for the second character to be
+                    * folded.  Then map_fold_len_back[n+m] is set to the
+                    * number of bytes occupied by the first two source
+                    * characters. ... */
+                   U8 map_fold_len_back[UTF8_MAXBYTES_CASE+1] = { 0 };
                    U8 folded[UTF8_MAXBYTES_CASE+1];
                    STRLEN foldlen = 0; /* num bytes in fold of 1st char */
-                   STRLEN foldlen_for_av; /* num bytes in fold of all chars */
+                   STRLEN total_foldlen = 0; /* num bytes in fold of all
+                                                 chars */
 
                    if (OP(n) == ANYOF || maxlen == 1 || ! lenp || ! av) {
 
                        /* Here, only need to fold the first char of the target
-                        * string */
+                        * string.  It the source wasn't utf8, is 1 byte long */
                        to_utf8_fold(utf8_p, folded, &foldlen);
-                       foldlen_for_av = foldlen;
-                       map_fold_len_back[1] = UTF8SKIP(utf8_p);
+                       total_foldlen = foldlen;
+                       map_fold_len_back[foldlen] = (utf8_target)
+                                                    ? UTF8SKIP(utf8_p)
+                                                    : 1;
                    }
                    else {
 
                        /* Here, need to fold more than the first char.  Do so
                         * up to the limits */
-                       UV which_char = 0;
                        U8* source_ptr = utf8_p;    /* The source for the fold
                                                       is the regex target
                                                       string */
@@ -6723,8 +6750,10 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n,
                        U8* e = utf8_p + maxlen;    /* Can't go beyond last
                                                       available byte in the
                                                       target string */
-                       while (which_char < UTF8_MAX_FOLD_CHAR_EXPAND
-                              && source_ptr < e)
+                       U8 i;
+                       for (i = 0;
+                            i < UTF8_MAX_FOLD_CHAR_EXPAND && source_ptr < e;
+                            i++)
                        {
 
                            /* Fold the next character */
@@ -6742,125 +6771,57 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n,
                                break;
                            }
 
-                           /* Save the first character's folded length, in
-                            * case we have to use it later */
-                           if (! foldlen) {
-                               foldlen = this_char_foldlen;
-                           }
-
-                           /* Here, add the fold of this character */
+                           /* Add the fold of this character */
                            Copy(this_char_folded,
                                 folded_ptr,
                                 this_char_foldlen,
                                 U8);
-                           which_char++;
-                           map_fold_len_back[which_char] =
-                               map_fold_len_back[which_char - 1]
-                               + UTF8SKIP(source_ptr);
-                           folded_ptr += this_char_foldlen;
                            source_ptr += UTF8SKIP(source_ptr);
+                           folded_ptr += this_char_foldlen;
+                           total_foldlen = folded_ptr - folded;
+
+                           /* Create map from the number of bytes in the fold
+                            * back to the number of bytes in the source.  If
+                            * the source isn't utf8, the byte count is just
+                            * the number of characters so far */
+                           map_fold_len_back[total_foldlen]
+                                                     = (utf8_target)
+                                                       ? source_ptr - utf8_p
+                                                       : i + 1;
                        }
                        *folded_ptr = '\0';
-                       foldlen_for_av = folded_ptr - folded;
                    }
 
 
                    /* Do the linear search to see if the fold is in the list
-                    * of multi-char folds.  (Useless to look if won't be able
-                    * to store that it is a multi-char fold in *lenp) */
-                   if (lenp && av) {
+                    * of multi-char folds. */
+                   if (av) {
                        I32 i;
                        for (i = 0; i <= av_len(av); i++) {
                            SV* const sv = *av_fetch(av, i, FALSE);
                            STRLEN len;
                            const char * const s = SvPV_const(sv, len);
-                           if (len <= foldlen_for_av && memEQ(s,
-                                                              (char*)folded,
-                                                              len))
+
+                           if (len <= total_foldlen
+                               && memEQ(s, (char*)folded, len)
+
+                                  /* If 0, means matched a partial char. See
+                                   * [perl #90536] */
+                               && map_fold_len_back[len])
                            {
 
                                /* Advance the target string ptr to account for
                                 * this fold, but have to translate from the
                                 * folded length to the corresponding source
-                                * length.  The array is indexed by how many
-                                * characters in the match */
-                               *lenp = map_fold_len_back[
-                                       utf8_length(folded, folded + len)];
+                                * length. */
+                               if (lenp) {
+                                   *lenp = map_fold_len_back[len];
+                               }
                                match = TRUE;
                                break;
                            }
                        }
                    }
-#if 0
-                   if (!match) { /* See if the folded version matches */
-                       SV** listp;
-
-                       /* Consider "k" =~ /[K]/i.  The line above would have
-                        * just folded the 'k' to itself, and that isn't going
-                        * to match 'K'.  So we look through the closure of
-                        * everything that folds to 'k'.  That will find the
-                        * 'K'.  Initialize the list, if necessary */
-                       if (! PL_utf8_foldclosures) {
-
-                           /* If the folds haven't been read in, call a fold
-                            * function to force that */
-                           if (! PL_utf8_tofold) {
-                               U8 dummy[UTF8_MAXBYTES+1];
-                               STRLEN dummy_len;
-                               to_utf8_fold((U8*) "A", dummy, &dummy_len);
-                           }
-                           PL_utf8_foldclosures =
-                                 _swash_inversion_hash(PL_utf8_tofold);
-                       }
-
-                       /* The data structure is a hash with the keys every
-                        * character that is folded to, like 'k', and the
-                        * values each an array of everything that folds to its
-                        * key.  e.g. [ 'k', 'K', KELVIN_SIGN ] */
-                       if ((listp = hv_fetch(PL_utf8_foldclosures,
-                                     (char *) folded, foldlen, FALSE)))
-                       {
-                           AV* list = (AV*) *listp;
-                           IV i;
-                           for (i = 0; i <= av_len(list); i++) {
-                               SV** try_p = av_fetch(list, i, FALSE);
-                               char* try_c;
-                               if (try_p == NULL) {
-                                   Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure");
-                               }
-                               /* Don't have to worry about embedded nulls
-                                * since NULL isn't folded or foldable */
-                               try_c = SvPVX(*try_p);
-
-                               /* The fold in a few cases  of an above Latin1
-                                * char is in the Latin1 range, and hence may
-                                * be in the bitmap */
-                               if (UTF8_IS_INVARIANT(*try_c)
-                                   && ANYOF_BITMAP_TEST(n,
-                                                   UNI_TO_NATIVE(*try_c)))
-                               {
-                                   match = TRUE;
-                                   break;
-                               }
-                               else if
-                                   (UTF8_IS_DOWNGRADEABLE_START(*try_c)
-                                    && ANYOF_BITMAP_TEST(n, UNI_TO_NATIVE(
-                                               TWO_BYTE_UTF8_TO_UNI(try_c[0],
-                                                                   try_c[1]))))
-                               {
-                                  /* Since the fold comes from internally
-                                   * generated data, we can safely assume it
-                                   * is valid utf8 in the test above */
-                                   match = TRUE;
-                                   break;
-                               } else if (swash_fetch(sw, (U8*) try_c, TRUE)) {
-                                   match = TRUE;
-                                   break;
-                               }
-                           }
-                       }
-                   }
-#endif
                }
 
                /* If we allocated a string above, free it */
@@ -6875,6 +6836,10 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n,
 STATIC U8 *
 S_reghop3(U8 *s, I32 off, const U8* lim)
 {
+    /* return the position 'off' UTF-8 characters away from 's', forward if
+     * 'off' >= 0, backwards if negative.  But don't go outside of position
+     * 'lim', which better be < s  if off < 0 */
+
     dVAR;
 
     PERL_ARGS_ASSERT_REGHOP3;
@@ -6994,16 +6959,16 @@ S_to_utf8_substr(pTHX_ register regexp *prog)
            prog->substrs->data[i].utf8_substr = sv;
            sv_utf8_upgrade(sv);
            if (SvVALID(prog->substrs->data[i].substr)) {
-               const U8 flags = BmFLAGS(prog->substrs->data[i].substr);
-               if (flags & FBMcf_TAIL) {
+               if (SvTAIL(prog->substrs->data[i].substr)) {
                    /* Trim the trailing \n that fbm_compile added last
                       time.  */
                    SvCUR_set(sv, SvCUR(sv) - 1);
                    /* Whilst this makes the SV technically "invalid" (as its
                       buffer is no longer followed by "\0") when fbm_compile()
                       adds the "\n" back, a "\0" is restored.  */
-               }
-               fbm_compile(sv, flags);
+                   fbm_compile(sv, FBMcf_TAIL);
+               } else
+                   fbm_compile(sv, 0);
            }
            if (prog->substrs->data[i].substr == prog->check_substr)
                prog->check_utf8 = sv;
@@ -7025,15 +6990,14 @@ S_to_byte_substr(pTHX_ register regexp *prog)
            SV* sv = newSVsv(prog->substrs->data[i].utf8_substr);
            if (sv_utf8_downgrade(sv, TRUE)) {
                if (SvVALID(prog->substrs->data[i].utf8_substr)) {
-                   const U8 flags
-                       = BmFLAGS(prog->substrs->data[i].utf8_substr);
-                   if (flags & FBMcf_TAIL) {
+                   if (SvTAIL(prog->substrs->data[i].utf8_substr)) {
                        /* Trim the trailing \n that fbm_compile added last
                           time.  */
                        SvCUR_set(sv, SvCUR(sv) - 1);
-                   }
-                   fbm_compile(sv, flags);
-               }           
+                       fbm_compile(sv, FBMcf_TAIL);
+                   } else
+                       fbm_compile(sv, 0);
+               }
            } else {
                SvREFCNT_dec(sv);
                sv = &PL_sv_undef;