From: Ævar Arnfjörð Bjarmason <avar@cpan.org>
Date: Wed, 9 Jan 2008 21:05:15 +0000 (+0000)
Subject: Move the reg_stringify logic to Perl_sv_2pv_flags
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=67d2d14de02de63c7c9137828ed7884f27d67b65;p=p5sagit%2Fp5-mst-13.2.git

Move the reg_stringify logic to Perl_sv_2pv_flags
Message-ID: <86zlveaewk.fsf@cpan.org>

with two corrections.
Plus remove reg_stringify from embed.fnc and regen.

p4raw-id: //depot/perl@32934
---

diff --git a/embed.fnc b/embed.fnc
index e7e978b..58426b2 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -688,7 +688,6 @@ Ap	|void	|pregfree	|NULLOK REGEXP* r
 Ap	|void	|pregfree2	|NN REGEXP* prog
 EXp	|REGEXP*|reg_temp_copy	|NN REGEXP* r
 Ap	|void	|regfree_internal|NULLOK REGEXP * const r
-Ap	|char *	|reg_stringify  |NN MAGIC *mg|NULLOK STRLEN *lp|NULLOK U32 *flags|NULLOK I32 *haseval
 #if defined(USE_ITHREADS)
 Ap	|void*	|regdupe_internal|NN REGEXP * const r|NN CLONE_PARAMS* param
 #endif
diff --git a/embed.h b/embed.h
index 377266a..653ec63 100644
--- a/embed.h
+++ b/embed.h
@@ -687,7 +687,6 @@
 #define reg_temp_copy		Perl_reg_temp_copy
 #endif
 #define regfree_internal	Perl_regfree_internal
-#define reg_stringify		Perl_reg_stringify
 #if defined(USE_ITHREADS)
 #define regdupe_internal	Perl_regdupe_internal
 #endif
@@ -2979,7 +2978,6 @@
 #define reg_temp_copy(a)	Perl_reg_temp_copy(aTHX_ a)
 #endif
 #define regfree_internal(a)	Perl_regfree_internal(aTHX_ a)
-#define reg_stringify(a,b,c,d)	Perl_reg_stringify(aTHX_ a,b,c,d)
 #if defined(USE_ITHREADS)
 #define regdupe_internal(a,b)	Perl_regdupe_internal(aTHX_ a,b)
 #endif
diff --git a/global.sym b/global.sym
index 021d86b..1d7bf87 100644
--- a/global.sym
+++ b/global.sym
@@ -402,7 +402,6 @@ Perl_pregfree
 Perl_pregfree2
 Perl_reg_temp_copy
 Perl_regfree_internal
-Perl_reg_stringify
 Perl_regdupe_internal
 Perl_pregcomp
 Perl_re_compile
diff --git a/perl.h b/perl.h
index 66cdf3e..f813175 100644
--- a/perl.h
+++ b/perl.h
@@ -209,10 +209,6 @@
 #define CALLREG_INTUIT_STRING(prog) \
     CALL_FPTR(RX_ENGINE(prog)->checkstr)(aTHX_ (prog))
 
-#define CALLREG_AS_STR(mg,lp,flags,haseval) \
-        Perl_reg_stringify(aTHX_ (mg), (lp), (flags), (haseval))
-#define CALLREG_STRINGIFY(mg,lp,flags) CALLREG_AS_STR(mg,lp,flags,0)
-
 #define CALLREGFREE(prog) \
     Perl_pregfree(aTHX_ (prog))
 
diff --git a/proto.h b/proto.h
index 0602069..992d3f7 100644
--- a/proto.h
+++ b/proto.h
@@ -1859,9 +1859,6 @@ PERL_CALLCONV REGEXP*	Perl_reg_temp_copy(pTHX_ REGEXP* r)
 			__attribute__nonnull__(pTHX_1);
 
 PERL_CALLCONV void	Perl_regfree_internal(pTHX_ REGEXP * const r);
-PERL_CALLCONV char *	Perl_reg_stringify(pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval)
-			__attribute__nonnull__(pTHX_1);
-
 #if defined(USE_ITHREADS)
 PERL_CALLCONV void*	Perl_regdupe_internal(pTHX_ REGEXP * const r, CLONE_PARAMS* param)
 			__attribute__nonnull__(pTHX_1)
diff --git a/regcomp.c b/regcomp.c
index 0c503e9..28c12d1 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -9569,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
  */
diff --git a/sv.c b/sv.c
index 5dfbba1..b26379f 100644
--- a/sv.c
+++ b/sv.c
@@ -2726,21 +2726,25 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 		    len = 7;
 		    retval = buffer = savepvn("NULLREF", len);
 		} else if (SvTYPE(referent) == SVt_REGEXP) {
-                    char *str = NULL;
-                    I32 haseval = 0;
-                    U32 flags = 0;
-		    struct magic temp;
-		    /* FIXME - get rid of this cast away of const, or work out
-		       how to do it better.  */
-		    temp.mg_obj = (SV *)referent;
-		    assert(temp.mg_obj);
-                    (str) = CALLREG_AS_STR(&temp,lp,&flags,&haseval);
-                    if (flags & 1)
-	                SvUTF8_on(sv);
-                    else
-	                SvUTF8_off(sv);
-                    PL_reginterp_cnt += haseval;
-		    return str;
+		    const REGEXP * const re = (REGEXP *)referent;
+		    I32 seen_evals = 0;
+
+		    assert(re);
+			
+		    /* If the regex is UTF-8 we want the containing scalar to
+		       have an UTF-8 flag too */
+		    if (RX_UTF8(re))
+			SvUTF8_on(sv);
+		    else
+			SvUTF8_off(sv);	
+
+		    if ((seen_evals = RX_SEEN_EVALS(re)))
+			PL_reginterp_cnt += seen_evals;
+
+		    if (lp)
+			*lp = RX_WRAPLEN(re);
+ 
+		    return RX_WRAPPED(re);
 		} else {
 		    const char *const typestr = sv_reftype(referent, 0);
 		    const STRLEN typelen = strlen(typestr);