X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regcomp.c;h=28c12d18aa55b0f9b4dfe3f29e9ade9f6dee7627;hb=ac27d13b824657b726428f3a6a1d5b3a01df569e;hp=48a6944fccd6b19cfe021799dcd57e88372fd60a;hpb=08e447406761619260203dbbef9cf10b6efa533c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/regcomp.c b/regcomp.c
index 48a6944..28c12d1 100644
--- 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
  */