Patch pl2bat.pl so batch file can fail

[p5sagit/p5-mst-13.2.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index 3569b3b..2d81da1 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -41,6 +41,8 @@
 #  define Perl_regnext my_regnext
 #  define Perl_save_re_context my_save_re_context
 #  define Perl_reginitcolors my_reginitcolors 
+
+#  define PERL_NO_GET_CONTEXT
 #endif 
 
 /*SUPPRESS 112*/
@@ -81,7 +83,11 @@
 #define PERL_IN_REGCOMP_C
 #include "perl.h"
 
-#ifndef PERL_IN_XSUB_RE
+#ifdef PERL_IN_XSUB_RE
+#  if defined(PERL_CAPI) || defined(PERL_OBJECT)
+#    include "XSUB.h"
+#  endif
+#else
 #  include "INTERN.h"
 #endif
 
@@ -169,11 +175,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
 
-STATIC void
-S_clear_re(pTHX_ void *r)
-{
-    ReREFCNT_dec((regexp *)r);
-}
+static void clear_re(pTHXo_ void *r);
 
 STATIC void
 S_scan_commit(pTHX_ scan_data_t *data)
@@ -409,7 +411,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
            if (data && (flags & SCF_DO_SUBSTR))
                data->pos_min += l;
        }
-       else if (strchr(PL_varies,OP(scan))) {
+       else if (strchr((char*)PL_varies,OP(scan))) {
            I32 mincount, maxcount, minnext, deltanext, pos_before, fl;
            regnode *oscan = scan;
            
@@ -465,7 +467,8 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
                if (ckWARN(WARN_UNSAFE) && (minnext + deltanext == 0) 
                    && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
                    && maxcount <= REG_INFTY/3) /* Complement check for big count */
-                   Perl_warner(aTHX_ WARN_UNSAFE, "Strange *+?{} on zero-length expression");
+                   Perl_warner(aTHX_ WARN_UNSAFE,
+                               "Strange *+?{} on zero-length expression");
                min += minnext * mincount;
                is_inf_internal |= (maxcount == REG_INFTY 
                                    && (minnext + deltanext) > 0
@@ -484,7 +487,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
 
                    /* Skip open. */
                    nxt = regnext(nxt);
-                   if (!strchr(PL_simple,OP(nxt))
+                   if (!strchr((char*)PL_simple,OP(nxt))
                        && !(PL_regkind[(U8)OP(nxt)] == EXACT
                             && *OPERAND(nxt) == 1)) 
                        goto nogo;
@@ -631,7 +634,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
                break;
            }
        }
-       else if (strchr(PL_simple,OP(scan)) || PL_regkind[(U8)OP(scan)] == ANYUTF8) {
+       else if (strchr((char*)PL_simple,OP(scan)) || PL_regkind[(U8)OP(scan)] == ANYUTF8) {
            if (flags & SCF_DO_SUBSTR) {
                scan_commit(data);
                data->pos_min++;
@@ -896,7 +899,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
        /* Starting-point info. */
       again:
        if (OP(first) == EXACT);        /* Empty, get anchored substr later. */
-       else if (strchr(PL_simple+4,OP(first)))
+       else if (strchr((char*)PL_simple+4,OP(first)))
            r->regstclass = first;
        else if (PL_regkind[(U8)OP(first)] == BOUND ||
                 PL_regkind[(U8)OP(first)] == NBOUND)
@@ -3031,7 +3034,7 @@ STATIC regnode *
 S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
 {
 #ifdef DEBUGGING
-    register char op = EXACT;  /* Arbitrary non-END op. */
+    register U8 op = EXACT;    /* Arbitrary non-END op. */
     register regnode *next, *onode;
 
     while (op != END && (!last || node < last)) {
@@ -3221,6 +3224,7 @@ void
 Perl_pregfree(pTHX_ struct regexp *r)
 {
     dTHR;
+    DEBUG_r(if (!PL_colorset) reginitcolors());
     DEBUG_r(PerlIO_printf(Perl_debug_log,
                      "%sFreeing REx:%s `%s%.60s%s%s'\n",
                      PL_colors[4],PL_colors[5],PL_colors[0],
@@ -3390,3 +3394,17 @@ Perl_save_re_context(pTHX)
     SAVEPPTR(PL_reg_starttry);         /* from regexec.c */    
 #endif
 }
+
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#include "XSUB.h"
+#undef this
+#define this pPerl
+#endif
+
+static void
+clear_re(pTHXo_ void *r)
+{
+    ReREFCNT_dec((regexp *)r);
+}
+