Generate the warnings masks programatically.
[p5sagit/p5-mst-13.2.git] / regcomp.c
index 96dd3f9..28c12d1 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -4264,7 +4264,7 @@ redo_first_pass:
     /* Allocate space and zero-initialize. Note, the two step process 
        of zeroing when in debug mode, thus anything assigned has to 
        happen after that */
-    rx = newSV_type(SVt_REGEXP);
+    rx = (REGEXP*) newSV_type(SVt_REGEXP);
     r = (struct regexp*)SvANY(rx);
     Newxc(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode),
         char, regexp_internal);
@@ -4294,7 +4294,7 @@ redo_first_pass:
             + (sizeof(STD_PAT_MODS) - 1)
             + (sizeof("(?:)") - 1);
 
-       p = sv_grow(rx, wraplen + 1);
+       p = sv_grow((SV *)rx, wraplen + 1);
        SvCUR_set(rx, wraplen);
        SvPOK_on(rx);
        SvFLAGS(rx) |= SvUTF8(pattern);
@@ -5219,7 +5219,10 @@ SV*
 Perl_reg_qr_package(pTHX_ REGEXP * const rx)
 {
        PERL_UNUSED_ARG(rx);
-       return NULL;
+       if (0)
+           return NULL;
+       else
+           return newSVpvs("Regexp");
 }
 
 /* Scans the name of a named buffer from the pattern.
@@ -9201,19 +9204,18 @@ Perl_pregfree2(pTHX_ REGEXP *rx)
     
 REGEXP *
 Perl_reg_temp_copy (pTHX_ REGEXP *rx) {
-    REGEXP *ret_x = newSV_type(SVt_REGEXP);
+    REGEXP *ret_x = (REGEXP*) newSV_type(SVt_REGEXP);
     struct regexp *ret = (struct regexp *)SvANY(ret_x);
     struct regexp *const r = (struct regexp *)SvANY(rx);
     register const I32 npar = r->nparens+1;
     (void)ReREFCNT_inc(rx);
-    /* FIXME ORANGE (once we start actually using the regular SV fields.) */
     /* We can take advantage of the existing "copied buffer" mechanism in SVs
        by pointing directly at the buffer, but flagging that the allocated
        space in the copy is zero. As we've just done a struct copy, it's now
        a case of zero-ing that, rather than copying the current length.  */
     SvPV_set(ret_x, RX_WRAPPED(rx));
     SvFLAGS(ret_x) |= SvFLAGS(rx) & (SVf_POK|SVp_POK|SVf_UTF8);
-    StructCopy(r, ret, regexp);
+    StructCopy(&(r->xpv_cur), &(ret->xpv_cur), struct regexp_allocated);
     SvLEN_set(ret_x, 0);
     Newx(ret->offs, npar, regexp_paren_pair);
     Copy(r->offs, ret->offs, npar, regexp_paren_pair);
@@ -9407,7 +9409,9 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param)
        /* Do it this way to avoid reading from *r after the StructCopy().
           That way, if any of the sv_dup_inc()s dislodge *r from the L1
           cache, it doesn't matter.  */
-       const bool anchored = r->check_substr == r->anchored_substr;
+       const bool anchored = r->check_substr
+           ? r->check_substr == r->anchored_substr
+           : r->check_utf8 == r->anchored_utf8;
         Newx(ret->substrs, 1, struct reg_substr_data);
        StructCopy(r->substrs, ret->substrs, struct reg_substr_data);
 
@@ -9430,6 +9434,12 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param)
                ret->check_substr = ret->float_substr;
                ret->check_utf8 = ret->float_utf8;
            }
+       } else if (ret->check_utf8) {
+           if (anchored) {
+               ret->check_utf8 = ret->anchored_utf8;
+           } else {
+               ret->check_utf8 = ret->float_utf8;
+           }
        }
     }
 
@@ -9448,7 +9458,6 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param)
 
     ret->mother_re      = NULL;
     ret->gofs = 0;
-    ret->seen_evals = 0;
 }
 #endif /* PERL_IN_XSUB_RE */
 
@@ -9560,48 +9569,8 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param)
 
 #endif    /* USE_ITHREADS */
 
-/* 
-   reg_stringify() 
-   
-   converts a regexp embedded in a MAGIC struct to its stringified form, 
-   caching the converted form in the struct and returns the cached 
-   string. 
-
-   If lp is nonnull then it is used to return the length of the 
-   resulting string
-   
-   If flags is nonnull and the returned string contains UTF8 then 
-   (*flags & 1) will be true.
-   
-   If haseval is nonnull then it is used to return whether the pattern 
-   contains evals.
-   
-   Normally called via macro: 
-   
-        CALLREG_STRINGIFY(mg,&len,&utf8);
-        
-   And internally with
-   
-        CALLREG_AS_STR(mg,&lp,&flags,&haseval)        
-    
-   See sv_2pv_flags() in sv.c for an example of internal usage.
-    
- */
 #ifndef PERL_IN_XSUB_RE
 
-char *
-Perl_reg_stringify(pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval ) {
-    dVAR;
-    const REGEXP * const re = (REGEXP *)mg->mg_obj;
-    if (haseval) 
-        *haseval = RX_SEEN_EVALS(re);
-    if (flags)    
-       *flags = RX_UTF8(re) ? 1 : 0;
-    if (lp)
-       *lp = RX_WRAPLEN(re);
-    return RX_WRAPPED(re);
-}
-
 /*
  - regnext - dig the "next" pointer out of a node
  */