Sys::Syslog doesn't need ppport.h in core
[p5sagit/p5-mst-13.2.git] / regcomp.c
index 2787636..7c08840 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -124,7 +124,10 @@ typedef struct RExC_state_t {
     regnode    **open_parens;          /* pointers to open parens */
     regnode    **close_parens;         /* pointers to close parens */
     regnode    *opend;                 /* END node in program */
-    I32                utf8;
+    I32                utf8;           /* whether the pattern is utf8 or not */
+    I32                orig_utf8;      /* whether the pattern was originally in utf8 */
+                               /* XXX use this for future optimisation of case
+                                * where pattern must be upgraded to utf8. */
     HV         *charnames;             /* cache of named sequences */
     HV         *paren_names;           /* Paren names */
     
@@ -168,6 +171,7 @@ typedef struct RExC_state_t {
 #define RExC_seen_zerolen      (pRExC_state->seen_zerolen)
 #define RExC_seen_evals        (pRExC_state->seen_evals)
 #define RExC_utf8      (pRExC_state->utf8)
+#define RExC_orig_utf8 (pRExC_state->orig_utf8)
 #define RExC_charnames  (pRExC_state->charnames)
 #define RExC_open_parens       (pRExC_state->open_parens)
 #define RExC_close_parens      (pRExC_state->close_parens)
@@ -1375,16 +1379,17 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
         U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
         const U8 *scan = (U8*)NULL;
         U32 wordlen      = 0;         /* required init */
-        STRLEN chars=0;
+        STRLEN chars = 0;
+        bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the bitmap?*/
 
         if (OP(noper) == NOTHING) {
             trie->minlen= 0;
             continue;
         }
-        if (trie->bitmap) {
-            TRIE_BITMAP_SET(trie,*uc);
-            if ( folder ) TRIE_BITMAP_SET(trie,folder[ *uc ]);            
-        }
+        if ( set_bit ) /* bitmap only alloced when !(UTF&&Folding) */
+            TRIE_BITMAP_SET(trie,*uc); /* store the raw first byte
+                                          regardless of encoding */
+
         for ( ; uc < e ; uc += len ) {
             TRIE_CHARCOUNT(trie)++;
             TRIE_READ_CHAR;
@@ -1396,6 +1401,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                         trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
                     TRIE_STORE_REVCHAR;
                 }
+                if ( set_bit ) {
+                    /* store the codepoint in the bitmap, and if its ascii
+                       also store its folded equivelent. */
+                    TRIE_BITMAP_SET(trie,uvc);
+                    if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
+                    set_bit = 0; /* We've done our bit :-) */
+                }
             } else {
                 SV** svpp;
                 if ( !widecharmap )
@@ -4052,16 +4064,18 @@ Perl_re_compile(pTHX_ char *exp, char *xend, PMOP *pm)
     if (exp == NULL)
        FAIL("NULL regexp argument");
 
-    RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
+    RExC_utf8 = RExC_orig_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
 
-    RExC_precomp = exp;
     DEBUG_COMPILE_r({
         SV *dsv= sv_newmortal();
         RE_PV_QUOTED_DECL(s, RExC_utf8,
-            dsv, RExC_precomp, (xend - exp), 60);
+            dsv, exp, (xend - exp), 60);
         PerlIO_printf(Perl_debug_log, "%sCompiling REx%s %s\n",
                       PL_colors[4],PL_colors[5],s);
     });
+
+redo_first_pass:
+    RExC_precomp = exp;
     RExC_flags = pm->op_pmflags;
     RExC_sawback = 0;
 
@@ -4100,6 +4114,25 @@ Perl_re_compile(pTHX_ char *exp, char *xend, PMOP *pm)
        RExC_precomp = NULL;
        return(NULL);
     }
+    if (RExC_utf8 && !RExC_orig_utf8) {
+        /* It's possible to write a regexp in ascii that represents unicode
+        codepoints outside of the byte range, such as via \x{100}. If we
+        detect such a sequence we have to convert the entire pattern to utf8
+        and then recompile, as our sizing calculation will have been based
+        on 1 byte == 1 character, but we will need to use utf8 to encode
+        at least some part of the pattern, and therefore must convert the whole
+        thing.
+        XXX: somehow figure out how to make this less expensive...
+        -- dmq */
+        STRLEN len = xend-exp;
+        DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log,
+           "UTF8 mismatch! Converting to utf8 for resizing and compile\n"));
+        exp = (char*)Perl_bytes_to_utf8(aTHX_ (U8*)exp, &len);
+        xend = exp + len;
+        RExC_orig_utf8 = RExC_utf8;
+        SAVEFREEPV(exp);
+        goto redo_first_pass;
+    }
     DEBUG_PARSE_r({
         PerlIO_printf(Perl_debug_log, 
             "Required size %"IVdf" nodes\n"
@@ -4956,7 +4989,6 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
     GET_RE_DEBUG_FLAGS_DECL;
     DEBUG_PARSE("reg ");
 
-
     *flagp = 0;                                /* Tentatively. */
 
 
@@ -5796,6 +5828,7 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth)
     I32 flags = 0, c = 0;
     GET_RE_DEBUG_FLAGS_DECL;
     DEBUG_PARSE("brnc");
+
     if (first)
        ret = NULL;
     else {
@@ -7900,7 +7933,7 @@ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op)
     if (RExC_offsets) {         /* MJD */
        MJD_OFFSET_DEBUG(("%s:%d: (op %s) %s %"UVuf" (len %"UVuf") (max %"UVuf").\n", 
               "reg_node", __LINE__, 
-              reg_name[op],
+              PL_reg_name[op],
               (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] 
                ? "Overwriting end of array!\n" : "OK",
               (UV)(RExC_emit - RExC_emit_start),
@@ -7954,7 +7987,7 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg)
        MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n", 
               "reganode",
              __LINE__,
-             reg_name[op],
+             PL_reg_name[op],
               (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ? 
               "Overwriting end of array!\n" : "OK",
               (UV)(RExC_emit - RExC_emit_start),
@@ -7994,7 +8027,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd, U32 depth)
     GET_RE_DEBUG_FLAGS_DECL;
     PERL_UNUSED_ARG(depth);
 /* (PL_regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */
-    DEBUG_PARSE_FMT("inst"," - %s",reg_name[op]);
+    DEBUG_PARSE_FMT("inst"," - %s",PL_reg_name[op]);
     if (SIZE_ONLY) {
        RExC_size += size;
        return;
@@ -8029,7 +8062,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd, U32 depth)
            MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s copy %"UVuf" -> %"UVuf" (max %"UVuf").\n",
                   "reg_insert",
                  __LINE__,
-                 reg_name[op],
+                 PL_reg_name[op],
                   (UV)(dst - RExC_emit_start) > RExC_offsets[0] 
                    ? "Overwriting end of array!\n" : "OK",
                   (UV)(src - RExC_emit_start),
@@ -8048,7 +8081,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd, U32 depth)
        MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n", 
               "reginsert",
              __LINE__,
-             reg_name[op],
+             PL_reg_name[op],
               (UV)(place - RExC_emit_start) > RExC_offsets[0] 
               ? "Overwriting end of array!\n" : "OK",
               (UV)(place - RExC_emit_start),
@@ -8092,7 +8125,7 @@ S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 de
             PerlIO_printf(Perl_debug_log, "~ %s (%d) %s %s\n",
                 SvPV_nolen_const(mysv), REG_NODE_NUM(scan),
                     (temp == NULL ? "->" : ""),
-                    (temp == NULL ? reg_name[OP(val)] : "")
+                    (temp == NULL ? PL_reg_name[OP(val)] : "")
             );
         });
         if (temp == NULL)
@@ -8173,7 +8206,7 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,
             PerlIO_printf(Perl_debug_log, "~ %s (%d) -> %s\n",
                 SvPV_nolen_const(mysv),
                 REG_NODE_NUM(scan),
-                reg_name[exact]);
+                PL_reg_name[exact]);
         });
        if (temp == NULL)
            break;
@@ -8331,7 +8364,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
        /* It would be nice to FAIL() here, but this may be called from
           regexec.c, and it would be hard to supply pRExC_state. */
        Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", (int)OP(o), (int)REGNODE_MAX);
-    sv_catpv(sv, reg_name[OP(o)]); /* Take off const! */
+    sv_catpv(sv, PL_reg_name[OP(o)]); /* Take off const! */
 
     k = PL_regkind[OP(o)];
 
@@ -8360,7 +8393,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
         const reg_trie_data * const trie
            = (reg_trie_data*)progi->data->data[!IS_TRIE_AC(op) ? n : ac->trie];
         
-        Perl_sv_catpvf(aTHX_ sv, "-%s",reg_name[o->flags]);
+        Perl_sv_catpvf(aTHX_ sv, "-%s",PL_reg_name[o->flags]);
         DEBUG_TRIE_COMPILE_r(
             Perl_sv_catpvf(aTHX_ sv,
                 "<S:%"UVuf"/%"IVdf" W:%"UVuf" L:%"UVuf"/%"UVuf" C:%"UVuf"/%"UVuf">",