[perl #37946] preserve the referent associated with a shared RV.

[perl5.git] / regexec.c

diff --git a/regexec.c b/regexec.c
index 6e234a2..a65ded7 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.
@@ -178,6 +178,7 @@ static void restore_pos(pTHX_ void *arg);
 STATIC CHECKPOINT
 S_regcppush(pTHX_ I32 parenfloor)
 {
+    dVAR;
     const int retval = PL_savestack_ix;
 #define REGCP_PAREN_ELEMS 4
     const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
@@ -222,6 +223,7 @@ S_regcppush(pTHX_ I32 parenfloor)
 STATIC char *
 S_regcppop(pTHX)
 {
+    dVAR;
     I32 i;
     U32 paren = 0;
     char *input;
@@ -286,6 +288,7 @@ S_regcppop(pTHX)
 STATIC char *
 S_regcp_set_to(pTHX_ I32 ss)
 {
+    dVAR;
     const I32 tmp = PL_savestack_ix;
 
     PL_savestack_ix = ss;
@@ -344,6 +347,7 @@ Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *stren
 STATIC void
 S_cache_re(pTHX_ regexp *prog)
 {
+    dVAR;
     PL_regprecomp = prog->precomp;             /* Needed for FAIL. */
 #ifdef DEBUGGING
     PL_regprogram = prog->program;
@@ -403,6 +407,7 @@ char *
 Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                     char *strend, U32 flags, re_scream_pos_data *data)
 {
+    dVAR;
     register I32 start_shift = 0;
     /* Should be nonnegative! */
     register I32 end_shift   = 0;
@@ -879,7 +884,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,
@@ -1633,6 +1638,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 /* data: May be used for some additional optimizations. */
 /* nosave: For optimizations. */
 {
+    dVAR;
     register char *s;
     register regnode *c;
     register char *startpos = stringarg;
@@ -2102,6 +2108,7 @@ phooey:
 STATIC I32                     /* 0 failure, 1 success */
 S_regtry(pTHX_ regexp *prog, char *startpos)
 {
+    dVAR;
     register I32 i;
     register I32 *sp;
     register I32 *ep;
@@ -2400,8 +2407,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*/
 
@@ -4601,6 +4608,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max)
 STATIC I32
 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
 {
+    dVAR;
     register char *scan = Nullch;
     register char *start;
     register char *loceol = PL_regeol;
@@ -4651,6 +4659,7 @@ S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
 SV *
 Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
 {
+    dVAR;
     SV *sw  = NULL;
     SV *si  = NULL;
     SV *alt = NULL;
@@ -4664,11 +4673,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)
@@ -4710,9 +4719,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)) {
@@ -4822,12 +4835,14 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp
 STATIC U8 *
 S_reghop(pTHX_ U8 *s, I32 off)
 {
+    dVAR;
     return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
 }
 
 STATIC U8 *
 S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
 {
+    dVAR;
     if (off >= 0) {
        while (off-- && s < lim) {
            /* XXX could check well-formedness here */
@@ -4852,12 +4867,14 @@ S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
 STATIC U8 *
 S_reghopmaybe(pTHX_ U8 *s, I32 off)
 {
+    dVAR;
     return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
 }
 
 STATIC U8 *
 S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
 {
+    dVAR;
     if (off >= 0) {
        while (off-- && s < lim) {
            /* XXX could check well-formedness here */
@@ -4888,6 +4905,7 @@ S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
 static void
 restore_pos(pTHX_ void *arg)
 {
+    dVAR;
     PERL_UNUSED_ARG(arg);
     if (PL_reg_eval_set) {
        if (PL_reg_oldsaved) {
@@ -4930,6 +4948,7 @@ S_to_utf8_substr(pTHX_ register regexp *prog)
 STATIC void
 S_to_byte_substr(pTHX_ register regexp *prog)
 {
+    dVAR;
     if (prog->float_utf8 && !prog->float_substr) {
        SV* sv;
        prog->float_substr = sv = newSVsv(prog->float_utf8);