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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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);