SvPV() does not take a const SV*, which means that the pattern argument

[perl5.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index c4313ae..8e197f7 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -57,7 +57,8 @@
  ****    Alterations to Henry's code are...
  ****
  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
+ ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ ****    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.
@@ -4156,7 +4157,7 @@ extern const struct regexp_engine my_reg_engine;
 
 #ifndef PERL_IN_XSUB_RE 
 REGEXP *
-Perl_pregcomp(pTHX_ const SV * const pattern, const U32 flags)
+Perl_pregcomp(pTHX_ SV * const pattern, const U32 flags)
 {
     dVAR;
     HV * const table = GvHV(PL_hintgv);
@@ -4182,14 +4183,14 @@ Perl_pregcomp(pTHX_ const SV * const pattern, const U32 flags)
 #endif
 
 REGEXP *
-Perl_re_compile(pTHX_ const SV * const pattern, U32 pm_flags)
+Perl_re_compile(pTHX_ SV * const pattern, U32 pm_flags)
 {
     dVAR;
     REGEXP *rx;
     struct regexp *r;
     register regexp_internal *ri;
     STRLEN plen;
-    char*  exp = SvPV((SV*)pattern, plen);
+    char  *exp = SvPV(pattern, plen);
     char* xend = exp + plen;
     regnode *scan;
     I32 flags;
@@ -4417,7 +4418,10 @@ reStudy:
     Zero(r->substrs, 1, struct reg_substr_data);
 
 #ifdef TRIE_STUDY_OPT
-    if ( restudied ) {
+    if (!restudied) {
+        StructCopy(&zero_scan_data, &data, scan_data_t);
+        copyRExC_state = RExC_state;
+    } else {
         U32 seen=RExC_seen;
         DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log,"Restudying\n"));
         
@@ -4432,9 +4436,6 @@ reStudy:
            SvREFCNT_dec(data.last_found);
        }
        StructCopy(&zero_scan_data, &data, scan_data_t);
-    } else {
-        StructCopy(&zero_scan_data, &data, scan_data_t);
-        copyRExC_state = RExC_state;
     }
 #else
     StructCopy(&zero_scan_data, &data, scan_data_t);
@@ -4838,7 +4839,7 @@ reStudy:
     if (RExC_seen & REG_SEEN_CUTGROUP)
        r->intflags |= PREGf_CUTGROUP_SEEN;
     if (RExC_paren_names)
-        RXp_PAREN_NAMES(r) = (HV*)SvREFCNT_inc(RExC_paren_names);
+        RXp_PAREN_NAMES(r) = MUTABLE_HV(SvREFCNT_inc(RExC_paren_names));
     else
         RXp_PAREN_NAMES(r) = NULL;
 
@@ -4985,13 +4986,11 @@ Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv,
                 } else {
                     ret = newSVsv(&PL_sv_undef);
                 }
-                if (retarray) {
-                    SvREFCNT_inc_simple_void(ret);
+                if (retarray)
                     av_push(retarray, ret);
-                }
             }
             if (retarray)
-                return newRV((SV*)retarray);
+                return newRV_noinc((SV*)retarray);
         }
     }
     return NULL;
@@ -5042,6 +5041,7 @@ SV*
 Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const r, const U32 flags)
 {
     struct regexp *const rx = (struct regexp *)SvANY(r);
+    GET_RE_DEBUG_FLAGS_DECL;
 
     PERL_ARGS_ASSERT_REG_NAMED_BUFF_NEXTKEY;
 
@@ -5054,7 +5054,7 @@ Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const r, const U32 flags)
             SV* sv_dat = HeVAL(temphe);
             I32 *nums = (I32*)SvPVX(sv_dat);
             for ( i = 0; i < SvIVX(sv_dat); i++ ) {
-                if ((I32)(rx->lastcloseparen) >= nums[i] &&
+                if ((I32)(rx->lastparen) >= nums[i] &&
                     rx->offs[nums[i]].start != -1 &&
                     rx->offs[nums[i]].end != -1)
                 {
@@ -5085,8 +5085,9 @@ Perl_reg_named_buff_scalar(pTHX_ REGEXP * const r, const U32 flags)
             return newSViv(HvTOTALKEYS(RXp_PAREN_NAMES(rx)));
         } else if (flags & RXapif_ONE) {
             ret = CALLREG_NAMED_BUFF_ALL(r, (flags | RXapif_REGNAMES));
-            av = (AV*)SvRV(ret);
+            av = MUTABLE_AV(SvRV(ret));
             length = av_len(av);
+           SvREFCNT_dec(ret);
             return newSViv(length + 1);
         } else {
             Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar", (int)flags);
@@ -5114,7 +5115,7 @@ Perl_reg_named_buff_all(pTHX_ REGEXP * const r, const U32 flags)
             SV* sv_dat = HeVAL(temphe);
             I32 *nums = (I32*)SvPVX(sv_dat);
             for ( i = 0; i < SvIVX(sv_dat); i++ ) {
-                if ((I32)(rx->lastcloseparen) >= nums[i] &&
+                if ((I32)(rx->lastparen) >= nums[i] &&
                     rx->offs[nums[i]].start != -1 &&
                     rx->offs[nums[i]].end != -1)
                 {
@@ -5128,7 +5129,7 @@ Perl_reg_named_buff_all(pTHX_ REGEXP * const r, const U32 flags)
         }
     }
 
-    return newRV((SV*)av);
+    return newRV_noinc((SV*)av);
 }
 
 void
@@ -5668,13 +5669,13 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
                                 pv = (I32*)SvGROW(sv_dat, SvCUR(sv_dat) + sizeof(I32)+1);
                                 SvCUR_set(sv_dat, SvCUR(sv_dat) + sizeof(I32));
                                 pv[count] = RExC_npar;
-                                SvIVX(sv_dat)++;
+                                SvIV_set(sv_dat, SvIVX(sv_dat) + 1);
                             }
                         } else {
                             (void)SvUPGRADE(sv_dat,SVt_PVNV);
                             sv_setpvn(sv_dat, (char *)&(RExC_npar), sizeof(I32));
                             SvIOK_on(sv_dat);
-                            SvIVX(sv_dat)= 1;
+                            SvIV_set(sv_dat, 1);
                         }
 #ifdef DEBUGGING
                         if (!av_store(RExC_paren_name_list, RExC_npar, SvREFCNT_inc(svname)))
@@ -5690,6 +5691,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
                 RExC_seen |= REG_SEEN_LOOKBEHIND;
                RExC_parse++;
            case '=':           /* (?=...) */
+               RExC_seen_zerolen++;
+                       break;
            case '!':           /* (?!...) */
                RExC_seen_zerolen++;
                if (*RExC_parse == ')') {
@@ -8348,6 +8351,9 @@ parseit:
         *STRING(ret)= (char)value;
         STR_LEN(ret)= 1;
         RExC_emit += STR_SZ(1);
+       if (listsv) {
+           SvREFCNT_dec(listsv);
+       }
         return ret;
     }
     /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
@@ -8839,7 +8845,7 @@ S_regcurly(register const char *s)
  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
  */
 #ifdef DEBUGGING
-void 
+static void 
 S_regdump_extflags(pTHX_ const char *lead, const U32 flags)
 {
     int bit;
@@ -8967,7 +8973,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
     
     PERL_ARGS_ASSERT_REGPROP;
 
-    sv_setpvn(sv, "", 0);
+    sv_setpvs(sv, "");
 
     if (OP(o) > REGNODE_MAX)           /* regnode.type is unsigned */
        /* It would be nice to FAIL() here, but this may be called from
@@ -9048,13 +9054,13 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
        Perl_sv_catpvf(aTHX_ sv, "%d", (int)ARG(o));    /* Parenth number */
        if ( RXp_PAREN_NAMES(prog) ) {
             if ( k != REF || OP(o) < NREF) {       
-               AV *list= (AV *)progi->data->data[progi->name_list_idx];
+               AV *list= MUTABLE_AV(progi->data->data[progi->name_list_idx]);
                SV **name= av_fetch(list, ARG(o), 0 );
                if (name)
                    Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name));
             }      
             else {
-                AV *list= (AV *)progi->data->data[ progi->name_list_idx ];
+                AV *list= MUTABLE_AV(progi->data->data[ progi->name_list_idx ]);
                 SV *sv_dat=(SV*)progi->data->data[ ARG( o ) ];
                 I32 *nums=(I32*)SvPVX(sv_dat);
                 SV **name= av_fetch(list, nums[0], 0 );
@@ -9427,7 +9433,7 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx)
                Safefree(ri->data->data[n]);
                break;
            case 'p':
-               new_comppad = (AV*)ri->data->data[n];
+               new_comppad = MUTABLE_AV(ri->data->data[n]);
                break;
            case 'o':
                if (new_comppad == NULL)
@@ -9502,15 +9508,15 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx)
 }
 
 #define sv_dup_inc(s,t)        SvREFCNT_inc(sv_dup(s,t))
-#define av_dup_inc(s,t)        (AV*)SvREFCNT_inc(sv_dup((SV*)s,t))
-#define hv_dup_inc(s,t)        (HV*)SvREFCNT_inc(sv_dup((SV*)s,t))
+#define av_dup_inc(s,t)        MUTABLE_AV(SvREFCNT_inc(sv_dup((const SV *)s,t)))
+#define hv_dup_inc(s,t)        MUTABLE_HV(SvREFCNT_inc(sv_dup((const SV *)s,t)))
 #define SAVEPVN(p,n)   ((p) ? savepvn(p,n) : NULL)
 
 /* 
    re_dup - duplicate a regexp. 
    
-   This routine is expected to clone a given regexp structure. It is not
-   compiler under USE_ITHREADS.
+   This routine is expected to clone a given regexp structure. It is only
+   compiled under USE_ITHREADS.
 
    After all of the core data stored in struct regexp is duplicated
    the regexp_engine.dupe method is used to copy any private data
@@ -9623,7 +9629,7 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param)
     npar = r->nparens+1;
     len = ProgLen(ri);
     
-    Newxc(reti, sizeof(regexp_internal) + (len+1)*sizeof(regnode), char, regexp_internal);
+    Newxc(reti, sizeof(regexp_internal) + len*sizeof(regnode), char, regexp_internal);
     Copy(ri->program, reti->program, len+1, regnode);
     
 
@@ -9939,11 +9945,11 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
            const reg_trie_data * const trie =
                (reg_trie_data*)ri->data->data[op<AHOCORASICK ? n : ac->trie];
 #ifdef DEBUGGING
-           AV *const trie_words = (AV *) ri->data->data[n + TRIE_WORDS_OFFSET];
+           AV *const trie_words = MUTABLE_AV(ri->data->data[n + TRIE_WORDS_OFFSET]);
 #endif
            const regnode *nextbranch= NULL;
            I32 word_idx;
-            sv_setpvn(sv, "", 0);
+            sv_setpvs(sv, "");
            for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) {
                SV ** const elem_ptr = av_fetch(trie_words,word_idx,0);