Further tweaks to make it easier to create regexp engine plug ins.

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

diff --git a/regcomp.c b/regcomp.c
index 359e4f6..1611eb4 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -3965,23 +3965,18 @@ Perl_reginitcolors(pTHX)
 extern const struct regexp_engine my_reg_engine;
 #define RE_ENGINE_PTR &my_reg_engine
 #endif
-/* these make a few things look better, to avoid indentation */
-#define BEGIN_BLOCK {
-#define END_BLOCK }
- 
+
+#ifndef PERL_IN_XSUB_RE 
 regexp *
 Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
 {
     dVAR;
-    GET_RE_DEBUG_FLAGS_DECL;
-    DEBUG_r(if (!PL_colorset) reginitcolors());
-#ifndef PERL_IN_XSUB_RE
-    BEGIN_BLOCK
+    HV * const table = GvHV(PL_hintgv);
     /* Dispatch a request to compile a regexp to correct 
        regexp engine. */
-    HV * const table = GvHV(PL_hintgv);
     if (table) {
         SV **ptr= hv_fetchs(table, "regcomp", FALSE);
+        GET_RE_DEBUG_FLAGS_DECL;
         if (ptr && SvIOK(*ptr) && SvIV(*ptr)) {
             const regexp_engine *eng=INT2PTR(regexp_engine*,SvIV(*ptr));
             DEBUG_COMPILE_r({
@@ -3991,9 +3986,14 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
             return CALLREGCOMP_ENG(eng, exp, xend, pm);
         } 
     }
-    END_BLOCK
+    return Perl_re_compile(aTHX_ exp, xend, pm);
+}
 #endif
-    BEGIN_BLOCK    
+
+regexp *
+Perl_re_compile(pTHX_ char *exp, char *xend, PMOP *pm)
+{
+    dVAR;
     register regexp *r;
     register regexp_internal *ri;
     regnode *scan;
@@ -4009,6 +4009,9 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     int restudied= 0;
     RExC_state_t copyRExC_state;
 #endif    
+    GET_RE_DEBUG_FLAGS_DECL;
+    DEBUG_r(if (!PL_colorset) reginitcolors());
+        
     if (exp == NULL)
        FAIL("NULL regexp argument");
 
@@ -4345,6 +4348,7 @@ reStudy:
        if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
             && data.last_start_min == 0 && data.last_end > 0
             && !RExC_seen_zerolen
+            && !(RExC_seen & REG_SEEN_VERBARG)
             && (!(RExC_seen & REG_SEEN_GPOS) || (r->extflags & RXf_ANCH_GPOS)))
            r->extflags |= RXf_CHECK_ALL;
        scan_commit(pRExC_state, &data,&minlen,0);
@@ -4593,11 +4597,9 @@ reStudy:
         PerlIO_printf(Perl_debug_log, "\n");
     });
     return(r);
-    END_BLOCK    
 }
 
 #undef CORE_ONLY_BLOCK
-#undef END_BLOCK
 #undef RE_ENGINE_PTR
 
 #ifndef PERL_IN_XSUB_RE
@@ -6364,27 +6366,42 @@ tryagain:
        case 'c':
        case '0':
            goto defchar;
-       case 'R': 
+       case 'g': 
        case '1': case '2': case '3': case '4':
        case '5': case '6': case '7': case '8': case '9':
            {
                I32 num;
-               bool isrel=(*RExC_parse=='R');
-               if (isrel)
+               bool isg = *RExC_parse == 'g';
+               bool isrel = 0; 
+               bool hasbrace = 0;
+               if (isg) {
                    RExC_parse++;
+                   if (*RExC_parse == '{') {
+                       RExC_parse++;
+                       hasbrace = 1;
+                   }
+                   if (*RExC_parse == '-') {
+                       RExC_parse++;
+                       isrel = 1;
+                   }
+               }   
                num = atoi(RExC_parse);
                 if (isrel) {
                     num = RExC_npar - num;
                     if (num < 1)
                         vFAIL("Reference to nonexistent or unclosed group");
                 }
-               if (num > 9 && num >= RExC_npar)
+               if (!isg && num > 9 && num >= RExC_npar)
                    goto defchar;
                else {
                    char * const parse_start = RExC_parse - 1; /* MJD */
                    while (isDIGIT(*RExC_parse))
                        RExC_parse++;
-
+                    if (hasbrace) {
+                        if (*RExC_parse != '}') 
+                            vFAIL("Unterminated \\g{...} pattern");
+                        RExC_parse++;
+                    }    
                    if (!SIZE_ONLY) {
                        if (num > (I32)RExC_rx->nparens)
                            vFAIL("Reference to nonexistent group");
@@ -6464,6 +6481,7 @@ tryagain:
                    case 'C':
                    case 'X':
                    case 'G':
+                   case 'g':
                    case 'Z':
                    case 'z':
                    case 'w':
@@ -8689,15 +8707,17 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param)
     Newx(ret->endp, npar, I32);
     Copy(r->endp, ret->endp, npar, I32);
 
-    Newx(ret->substrs, 1, struct reg_substr_data);
-    for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
-       s->min_offset = r->substrs->data[i].min_offset;
-       s->max_offset = r->substrs->data[i].max_offset;
-       s->end_shift  = r->substrs->data[i].end_shift;
-       s->substr     = sv_dup_inc(r->substrs->data[i].substr, param);
-       s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param);
-    }
-    
+    if (ret->substrs) {
+        Newx(ret->substrs, 1, struct reg_substr_data);
+        for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
+            s->min_offset = r->substrs->data[i].min_offset;
+            s->max_offset = r->substrs->data[i].max_offset;
+            s->end_shift  = r->substrs->data[i].end_shift;
+            s->substr     = sv_dup_inc(r->substrs->data[i].substr, param);
+            s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param);
+        }
+    } else 
+        ret->substrs = NULL;    
 
     ret->precomp        = SAVEPVN(r->precomp, r->prelen);
     ret->refcnt         = r->refcnt;
@@ -8725,7 +8745,8 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param)
 #endif
     
     ret->pprivate = r->pprivate;
-    RXi_SET(ret,CALLREGDUPE_PVT(ret,param));
+    if (ret->pprivate) 
+        RXi_SET(ret,CALLREGDUPE_PVT(ret,param));
     
     ptr_table_store(PL_ptr_table, r, ret);
     return ret;