This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Correct POD formatting error: '=back' should be within '=begin =end' block.
[perl5.git] / regexec.c
index 516bf95..ced20bd 100644 (file)
--- a/regexec.c
+++ b/regexec.c
 #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 { \
+#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); LEAVE; } } STMT_END
+       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 __attribute__unused__; \
+       bool throw_away PERL_UNUSED_DECL; \
        ENTER; save_re_context(); \
        throw_away = CAT2(is_utf8_,class)((const U8*)" "); \
        LEAVE; } } STMT_END
@@ -696,12 +702,22 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
        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 (((U32 *)mg->mg_ptr)[BmRARE(check)] != (U32)~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) ))
@@ -1184,8 +1200,8 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
            uscan += len;                                                   \
            len=0;                                                          \
        } else {                                                            \
-           uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
-           uvc = to_uni_fold( uvc, foldbuf, &foldlen );                    \
+           uvc = to_utf8_fold( (U8 *) uc, foldbuf, &foldlen );             \
+           len = UTF8SKIP(uc); \
            foldlen -= UNISKIP( uvc );                                      \
            uscan = foldbuf + UNISKIP( uvc );                               \
        }                                                                   \
@@ -1447,22 +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;
-           }
-
-           /* 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;
-           goto do_exactf_non_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;
@@ -1476,6 +1481,19 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
            }
            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 */
 
@@ -1490,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) {
@@ -1507,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
@@ -1519,12 +1545,35 @@ 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, rounding up, so that
+            * if we need to match at least 4+1/3 chars, that really is 5. */
+           expansion = (utf8_target) ? UTF8_MAX_FOLD_CHAR_EXPAND : 2;
+           lnc = (lnc + expansion - 1) / 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 to stop the loop 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.
+            * This would happen only after we reached the point in the loop
+            * where if there were no expansion we should fail.  Unclear if
+            * worth the expense */
+
            while (s <= e) {
                char *my_strend= (char *)strend;
                if (foldEQ_utf8_flags(s, &my_strend, 0,  utf8_target,
@@ -1533,9 +1582,10 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
                {
                    goto got_it;
                }
-               s += UTF8SKIP(s);
+               s += (utf8_target) ? UTF8SKIP(s) : 1;
            }
            break;
+       }
        case BOUNDL:
            PL_reg_flags |= RF_tainted;
            FBC_BOUND(isALNUM_LC,
@@ -3613,7 +3663,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
        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:
@@ -3625,7 +3675,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
        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);
@@ -3675,7 +3725,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 {
@@ -3722,6 +3775,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;
@@ -3821,17 +3875,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)
@@ -3841,7 +3895,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++;
            }
@@ -4203,6 +4258,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;
 
@@ -4223,6 +4284,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;
@@ -5661,6 +5723,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);          \
@@ -5668,6 +5732,8 @@ NULL
                 sayNO;                                \
             break;                                    \
         case N##nAmE:                                 \
+           if (locinput >= PL_regeol)                \
+               sayNO;                                \
             if ((n=is_##nAmE(locinput,utf8_target))) {    \
                 sayNO;                                \
             } else {                                  \
@@ -5942,7 +6008,7 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
 
            /* Here, the string is utf8, and the pattern char is different
             * in utf8 than not, so can't compare them directly.  Outside the
-            * loop, find find the two utf8 bytes that represent c, and then
+            * loop, find the two utf8 bytes that represent c, and then
             * look for those in sequence in the utf8 string */
            U8 high = UTF8_TWO_BYTE_HI(c);
            U8 low = UTF8_TWO_BYTE_LO(c);
@@ -5969,7 +6035,7 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
 
     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 */
@@ -6772,6 +6838,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;