Fix a couple of typos.
[p5sagit/p5-mst-13.2.git] / regcomp.c
index 07e68bd..7b4d647 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5,6 +5,16 @@
  * "A fair jaw-cracker dwarf-language must be."  --Samwise Gamgee
  */
 
+/* This file contains functions for compiling a regular expression.  See
+ * also regexec.c which funnily enough, contains functions for executing
+ * a regular expression.
+ *
+ * This file is also copied at build time to ext/re/re_comp.c, where
+ * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
+ * This causes the main functions to be compiled under new names and with
+ * debugging support added, which makes "use re 'debug'" work.
+ */
+
 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
  * confused with the original package (see point 3 below).  Thanks, Henry!
  */
 #endif /* op */
 
 #ifdef MSDOS
-# if defined(BUGGY_MSC6)
+#  if defined(BUGGY_MSC6)
  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
- # pragma optimize("a",off)
+#    pragma optimize("a",off)
  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
- # pragma optimize("w",on )
-# endif /* BUGGY_MSC6 */
+#    pragma optimize("w",on )
+#  endif /* BUGGY_MSC6 */
 #endif /* MSDOS */
 
 #ifndef STATIC
@@ -1188,7 +1198,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                if (  OP(oscan) == CURLYX && data
                      && !(data->flags & SF_HAS_PAR)
                      && !(data->flags & SF_HAS_EVAL)
-                     && !deltanext  ) {
+                     && !deltanext     /* atom is fixed width */
+                     && minnext != 0   /* CURLYM can't handle zero width */
+               ) {
                    /* XXXX How to optimize if data == 0? */
                    /* Optimize to a simpler form.  */
                    regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
@@ -2253,13 +2265,13 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                }
                else {                                          /* First pass */
                    if (PL_reginterp_cnt < ++RExC_seen_evals
-                       && PL_curcop != &PL_compiling)
+                       && IN_PERL_RUNTIME)
                        /* No compiled RE interpolated, has runtime
                           components ===> unsafe.  */
                        FAIL("Eval-group not allowed at runtime, use re 'eval'");
                    if (PL_tainting && PL_tainted)
                        FAIL("Eval-group in insecure regular expression");
-                   if (PL_curcop == &PL_compiling)
+                   if (IN_PERL_COMPILETIME)
                        PL_cv_has_eval = 1;
                }
 
@@ -2511,8 +2523,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
            if (paren == '>')
                node = SUSPEND, flag = 0;
            reginsert(pRExC_state, node,ret);
-           Set_Node_Offset(ret, oregcomp_parse);
-           Set_Node_Length(ret,  RExC_parse - oregcomp_parse + 2);
+           Set_Node_Cur_Length(ret);
+           Set_Node_Offset(ret, parse_start + 1);
            ret->flags = flag;
            regtail(pRExC_state, ret, reg_node(pRExC_state, TAIL));
        }
@@ -2793,7 +2805,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
 {
     register regnode *ret = 0;
     I32 flags;
-    char *parse_start = 0;
+    char *parse_start = RExC_parse;
 
     *flagp = WORST;            /* Tentatively. */
 
@@ -3056,6 +3068,7 @@ tryagain:
        default:
            /* Do not generate `unrecognized' warnings here, we fall
               back into the quick-grab loop below */
+           parse_start--;
            goto defchar;
        }
        break;
@@ -3162,11 +3175,6 @@ tryagain:
                                ender = grok_hex(p + 1, &numlen, &flags, NULL);
                                if (ender > 0xff)
                                    RExC_utf8 = 1;
-                               /* numlen is generous */
-                               if (numlen + len >= 127) {
-                                   p--;
-                                   goto loopdone;
-                               }
                                p = e + 1;
                            }
                        }
@@ -3663,7 +3671,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
                }
                RExC_parse = e + 1;
                ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
-               continue;
+               namedclass = ANYOF_MAX;  /* no official name, but it's named */
+               break;
            case 'n':   value = '\n';                   break;
            case 'r':   value = '\r';                   break;
            case 't':   value = '\t';                   break;
@@ -4068,6 +4077,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
                    }
                    Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsXDigit\n");
                    break;
+               case ANYOF_MAX:
+                   /* this is to handle \p and \P */
+                   break;
                default:
                    vFAIL("Invalid [::] class");
                    break;
@@ -4430,6 +4442,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd)
               RExC_parse - RExC_start,
               RExC_offsets[0])); 
        Set_Node_Offset(place, RExC_parse);
+       Set_Node_Length(place, 1);
     }
     src = NEXTOPER(place);
     FILL_ADVANCE_NODE(place, op);
@@ -4954,6 +4967,7 @@ Perl_pregfree(pTHX_ struct regexp *r)
        int n = r->data->count;
        PAD* new_comppad = NULL;
        PAD* old_comppad;
+       PADOFFSET refcnt;
 
        while (--n >= 0) {
           /* If you add a ->what type here, update the comment in regcomp.h */
@@ -4975,9 +4989,11 @@ Perl_pregfree(pTHX_ struct regexp *r)
                    (SvTYPE(new_comppad) == SVt_PVAV) ?
                                new_comppad : Null(PAD *)
                );
-               if (!OpREFCNT_dec((OP_4tree*)r->data->data[n])) {
+               OP_REFCNT_LOCK;
+               refcnt = OpREFCNT_dec((OP_4tree*)r->data->data[n]);
+               OP_REFCNT_UNLOCK;
+               if (!refcnt)
                     op_free((OP_4tree*)r->data->data[n]);
-               }
 
                PAD_RESTORE_LOCAL(old_comppad);
                SvREFCNT_dec((SV*)new_comppad);
@@ -5048,7 +5064,7 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
     if (l1 > 512)
        l1 = 512;
     Copy(message, buf, l1 , char);
-    buf[l1] = '\0';                    /* Overwrite \n */
+    buf[l1-1] = '\0';                  /* Overwrite \n */
     Perl_croak(aTHX_ "%s", buf);
 }