Generate the warnings masks programatically.
[p5sagit/p5-mst-13.2.git] / regcomp.c
index 48a6944..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,7 +9204,7 @@ 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;
@@ -9406,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);
 
@@ -9429,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;
+           }
        }
     }
 
@@ -9447,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 */
 
@@ -9559,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
  */