Re: [perl #38034] A combination eval, DESTROY method and $@ - dangerous - bug

[p5sagit/p5-mst-13.2.git] / regexec.c

diff --git a/regexec.c b/regexec.c
index e058216..de95e31 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.
@@ -518,6 +518,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;
          }
        }
@@ -878,7 +879,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
         s = find_byclass(prog, prog->regstclass, s, endpos, 1);
        if (!s) {
 #ifdef DEBUGGING
-           const char *what = 0;
+           const char *what = NULL;
 #endif
            if (endpos == strend) {
                DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
@@ -2399,8 +2400,8 @@ S_regmatch(pTHX_ regnode *prog)
     I32 unwind = 0;
 
     /* used by the trie code */
-    SV                 *sv_accept_buff = 0;  /* accepting states we have traversed */
-    reg_trie_accepted  *accept_buff = 0;     /* "" */
+    SV                 *sv_accept_buff = NULL; /* accepting states we have traversed */
+    reg_trie_accepted  *accept_buff = NULL;  /* "" */
     reg_trie_data      *trie;                /* what trie are we using right now */
     U32 accepted = 0;                        /* how many accepting states we have seen*/
 
@@ -4663,11 +4664,11 @@ Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsv
            SV **const ary = AvARRAY(av);
            SV **a, **b;
        
-           /* See the end of regcomp.c:S_reglass() for
+           /* See the end of regcomp.c:S_regclass() for
             * 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)
@@ -4709,9 +4710,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))
-        c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
-                           ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+    if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
+       c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
+                           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)) {