Email address changes

[perl5.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index 0e53589..6ba85bb 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -30,29 +30,7 @@
 */
 
 #ifdef PERL_EXT_RE_BUILD
-/* need to replace pregcomp et al, so enable that */
-#  ifndef PERL_IN_XSUB_RE
-#    define PERL_IN_XSUB_RE
-#  endif
-/* need access to debugger hooks */
-#  if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
-#    define DEBUGGING
-#  endif
-#endif
-
-#ifdef PERL_IN_XSUB_RE
-/* We *really* need to overwrite these symbols: */
-#  define Perl_pregcomp my_regcomp
-#  define Perl_regdump my_regdump
-#  define Perl_regprop my_regprop
-#  define Perl_pregfree my_regfree
-#  define Perl_re_intuit_string my_re_intuit_string
-/* *These* symbols are masked to allow static link. */
-#  define Perl_regnext my_regnext
-#  define Perl_save_re_context my_save_re_context
-#  define Perl_reginitcolors my_reginitcolors
-
-#  define PERL_NO_GET_CONTEXT
+#include "re_top.h"
 #endif
 
 /*
@@ -98,7 +76,11 @@
 #endif
 
 #define REG_COMP_C
-#include "regcomp.h"
+#ifdef PERL_IN_XSUB_RE
+#  include "re_comp.h"
+#else
+#  include "regcomp.h"
+#endif
 
 #ifdef op
 #undef op
@@ -1016,7 +998,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                });
 
            } else {
-               /*EMPTY*/;   /* It's a dupe. So ignore it. */
+               NOOP;   /* It's a dupe. So ignore it. */
            }
 
         } /* end second pass */
@@ -1222,7 +1204,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                 });
 
             } else {
-               /*EMPTY*/;  /* Its a dupe. So ignore it. */
+               NOOP;  /* Its a dupe. So ignore it. */
             }
 
         } /* end second pass */
@@ -1883,7 +1865,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                                     SvPV_nolen_const(mysv));
                                 }
                                 PerlIO_printf( Perl_debug_log, "0x%p,0x%p,0x%p)\n",
-                                   first, last, cur );
+                                   (void*)first, (void*)last, (void*)cur );
                             });
                             if ( ( first ? OP( noper ) == optype
                                          : PL_regkind[ (U8)OP( noper ) ] == EXACT )
@@ -1940,7 +1922,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                             regprop(RExC_rx, mysv, cur);
                             PerlIO_printf( Perl_debug_log,
                               "%*s%s\t(0x%p,0x%p,0x%p)\n", (int)depth * 2 + 2,
-                              "  ", SvPV_nolen_const( mysv ), first, last, cur);
+                              "  ", SvPV_nolen_const( mysv ), (void*)first, (void*)last, (void*)cur);
 
                         });
                         if ( last ) {
@@ -2753,6 +2735,7 @@ S_add_data(RExC_state_t *pRExC_state, I32 n, const char *s)
     return RExC_rx->data->count - n;
 }
 
+#ifndef PERL_IN_XSUB_RE
 void
 Perl_reginitcolors(pTHX)
 {
@@ -2778,7 +2761,7 @@ Perl_reginitcolors(pTHX)
     }
     PL_colorset = 1;
 }
-
+#endif
 
 /*
  - pregcomp - compile a regular expression into internal code
@@ -2955,7 +2938,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
       again:
        if (PL_regkind[(U8)OP(first)] == EXACT) {
            if (OP(first) == EXACT)
-               /*EMPTY*/;      /* Empty, get anchored substr later. */
+               NOOP;   /* Empty, get anchored substr later. */
            else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
                r->regstclass = first;
        }
@@ -3324,8 +3307,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                        FAIL("Eval-group not allowed at runtime, use re 'eval'");
                    if (PL_tainting && PL_tainted)
                        FAIL("Eval-group in insecure regular expression");
+#if PERL_VERSION > 8
                    if (IN_PERL_COMPILETIME)
                        PL_cv_has_eval = 1;
+#endif
                }
 
                nextchar(pRExC_state);
@@ -5801,7 +5786,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
                       len, s,
                       PL_colors[1]);
     } else if (k == TRIE) {
-       /*EMPTY*/;
+       NOOP;
        /* print the details od the trie in dumpuntil instead, as
         * prog->data isn't available here */
     } else if (k == CURLY) {
@@ -5878,7 +5863,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
        }
 
        if (o->flags & ANYOF_CLASS)
-           for (i = 0; i < sizeof(anyofs)/sizeof(char*); i++)
+           for (i = 0; i < (int)(sizeof(anyofs)/sizeof(char*)); i++)
                if (ANYOF_CLASS_TEST(o,i))
                    sv_catpv(sv, anyofs[i]);
 
@@ -5994,9 +5979,8 @@ Perl_pregfree(pTHX_ struct regexp *r)
     dVAR;
 #ifdef DEBUGGING
     SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
-    SV * const re_debug_flags=get_sv(RE_DEBUG_FLAGS,0);
 #endif
-
+    GET_RE_DEBUG_FLAGS_DECL;
 
     if (!r || (--r->refcnt > 0))
        return;
@@ -6107,6 +6091,7 @@ Perl_pregfree(pTHX_ struct regexp *r)
     Safefree(r);
 }
 
+#ifndef PERL_IN_XSUB_RE
 /*
  - regnext - dig the "next" pointer out of a node
  */
@@ -6125,6 +6110,7 @@ Perl_regnext(pTHX_ register regnode *p)
 
     return(p+offset);
 }
+#endif
 
 STATIC void    
 S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
@@ -6162,6 +6148,7 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
 
 /* XXX Here's a total kludge.  But we need to re-enter for swash routines. */
 
+#ifndef PERL_IN_XSUB_RE
 void
 Perl_save_re_context(pTHX)
 {
@@ -6197,7 +6184,11 @@ Perl_save_re_context(pTHX)
            U32 i;
            for (i = 1; i <= rx->nparens; i++) {
                char digits[TYPE_CHARS(long)];
+#ifdef USE_SNPRINTF
+               const STRLEN len = snprintf(digits, sizeof(digits), "%lu", (long)i);
+#else
                const STRLEN len = my_sprintf(digits, "%lu", (long)i);
+#endif /* #ifdef USE_SNPRINTF */
                GV *const *const gvp
                    = (GV**)hv_fetch(PL_defstash, digits, len, 0);
 
@@ -6210,6 +6201,7 @@ Perl_save_re_context(pTHX)
        }
     }
 }
+#endif
 
 static void
 clear_re(pTHX_ void *r)