This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate:
[perl5.git] / regexec.c
index 6dfd905..b9ebb9f 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -78,7 +78,7 @@
  ****    Alterations to Henry's code are...
  ****
  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- ****    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  ****
  ****    You may distribute under the terms of either the GNU General Public
  ****    License or the Artistic License, as specified in the README file.
@@ -512,6 +512,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                     || ((slen = SvCUR(check)) > 1
                         && memNE(SvPVX_const(check), s, slen)))
                goto report_neq;
+           check_at = s;
            goto success_at_start;
          }
        }
@@ -1035,14 +1036,15 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32
                U8 *sm = (U8 *) m;
                U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
                U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
+               const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
 
                to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
                to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
 
                c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE, 
-                                   0, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+                                   0, uniflags);
                c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
-                                   0, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+                                   0, uniflags);
                lnc = 0;
                while (sm < ((U8 *) m + ln)) {
                    lnc++;
@@ -1081,14 +1083,13 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32
                UV c, f;
                U8 tmpbuf [UTF8_MAXBYTES+1];
                STRLEN len, foldlen;
-               
+               const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
                if (c1 == c2) {
                    /* Upper and lower of 1st char are equal -
                     * probably not a "letter". */
                    while (s <= e) {
                        c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
-                                          ckWARN(WARN_UTF8) ?
-                                          0 : UTF8_ALLOW_ANY);
+                                          uniflags);
                        if ( c == c1
                             && (ln == len ||
                                 ibcmp_utf8(s, (char **)0, 0,  do_utf8,
@@ -1115,8 +1116,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32
                else {
                    while (s <= e) {
                      c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
-                                          ckWARN(WARN_UTF8) ?
-                                          0 : UTF8_ALLOW_ANY);
+                                          uniflags);
 
                        /* Handle some of the three Greek sigmas cases.
                         * Note that not all the possible combinations
@@ -2316,12 +2316,13 @@ S_regmatch(pTHX_ regnode *prog)
 #if 0
     I32 firstcp = PL_savestack_ix;
 #endif
-    const register bool do_utf8 = PL_reg_match_utf8;
+    register const bool do_utf8 = PL_reg_match_utf8;
 #ifdef DEBUGGING
     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
     SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
 #endif
+    U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
 
 #ifdef DEBUGGING
     PL_regindent++;
@@ -2475,7 +2476,6 @@ S_regmatch(pTHX_ regnode *prog)
            else
                nextchr = UCHARAT(++locinput);
            break;
-
        case EXACT:
            s = STRING(scan);
            ln = STR_LEN(scan);
@@ -2492,8 +2492,7 @@ S_regmatch(pTHX_ regnode *prog)
                             sayNO;
                        if (NATIVE_TO_UNI(*(U8*)s) !=
                            utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
-                                          ckWARN(WARN_UTF8) ?
-                                          0 : UTF8_ALLOW_ANY))
+                                           uniflags))
                             sayNO;
                        l += ulen;
                        s ++;
@@ -2507,8 +2506,7 @@ S_regmatch(pTHX_ regnode *prog)
                            sayNO;
                        if (NATIVE_TO_UNI(*((U8*)l)) !=
                            utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
-                                          ckWARN(WARN_UTF8) ?
-                                          0 : UTF8_ALLOW_ANY))
+                                          uniflags))
                            sayNO;
                        s += ulen;
                        l ++;
@@ -3625,16 +3623,13 @@ S_regmatch(pTHX_ regnode *prog)
                             to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
 
                             c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
-                                                ckWARN(WARN_UTF8) ?
-                                                0 : UTF8_ALLOW_ANY);
+                                                uniflags);
                             c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
-                                                ckWARN(WARN_UTF8) ?
-                                                0 : UTF8_ALLOW_ANY);
+                                                uniflags);
                        }
                        else {
                            c2 = c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
-                                                    ckWARN(WARN_UTF8) ?
-                                                    0 : UTF8_ALLOW_ANY);
+                                                    uniflags);
                        }
                    }
                }
@@ -3695,8 +3690,7 @@ S_regmatch(pTHX_ regnode *prog)
                                while (locinput <= e &&
                                       utf8n_to_uvchr((U8*)locinput,
                                                      UTF8_MAXBYTES, &len,
-                                                     ckWARN(WARN_UTF8) ?
-                                                     0 : UTF8_ALLOW_ANY) != (UV)c1) {
+                                                     uniflags) != (UV)c1) {
                                    locinput += len;
                                    count++;
                                }
@@ -3707,8 +3701,7 @@ S_regmatch(pTHX_ regnode *prog)
                                while (locinput <= e) {
                                    UV c = utf8n_to_uvchr((U8*)locinput,
                                                          UTF8_MAXBYTES, &len,
-                                                         ckWARN(WARN_UTF8) ?
-                                                         0 : UTF8_ALLOW_ANY);
+                                                         uniflags);
                                    if (c == (UV)c1 || c == (UV)c2)
                                        break;
                                    locinput += len;
@@ -3744,8 +3737,7 @@ S_regmatch(pTHX_ regnode *prog)
                        if (do_utf8)
                            c = utf8n_to_uvchr((U8*)PL_reginput,
                                               UTF8_MAXBYTES, 0,
-                                              ckWARN(WARN_UTF8) ?
-                                              0 : UTF8_ALLOW_ANY);
+                                              uniflags);
                        else
                            c = UCHARAT(PL_reginput);
                        /* If it could work, try it. */
@@ -3794,8 +3786,7 @@ S_regmatch(pTHX_ regnode *prog)
                            if (do_utf8)
                                c = utf8n_to_uvchr((U8*)PL_reginput,
                                                   UTF8_MAXBYTES, 0,
-                                                  ckWARN(WARN_UTF8) ?
-                                                  0 : UTF8_ALLOW_ANY);
+                                                  uniflags);
                            else
                                c = UCHARAT(PL_reginput);
                        }
@@ -3817,8 +3808,7 @@ S_regmatch(pTHX_ regnode *prog)
                            if (do_utf8)
                                c = utf8n_to_uvchr((U8*)PL_reginput,
                                                   UTF8_MAXBYTES, 0,
-                                                  ckWARN(WARN_UTF8) ?
-                                                  0 : UTF8_ALLOW_ANY);
+                                                  uniflags);
                            else
                                c = UCHARAT(PL_reginput);
                        }
@@ -4361,7 +4351,7 @@ Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** listsvp, SV
             * documentation of these array elements. */
 
            si = *ary;
-           a  = SvTYPE(ary[1]) == SVt_RV   ? &ary[1] : 0;
+           a  = SvROK(ary[1]) ? &ary[1] : 0;
            b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
 
            if (a)
@@ -4402,9 +4392,13 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp
     STRLEN len = 0;
     STRLEN plen;
 
-    if (do_utf8 && !UTF8_IS_INVARIANT(c))
+    if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
        c = utf8n_to_uvchr((U8 *)p, UTF8_MAXBYTES, &len,
-                           ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+                           ckWARN(WARN_UTF8) ? UTF8_CHECK_ONLY :
+                                       UTF8_ALLOW_ANYUV|UTF8_CHECK_ONLY);
+       if (len == (STRLEN)-1)
+           Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
+    }
 
     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
     if (do_utf8 || (flags & ANYOF_UNICODE)) {