and [BUG] \X and \C fixed, \X still dorked

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

diff --git a/regcomp.c b/regcomp.c
index 0a63f22..4cfd3db 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -522,11 +522,8 @@ S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data)
 STATIC void
 S_cl_anything(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
 {
-    int value;
-
     ANYOF_CLASS_ZERO(cl);
-    for (value = 0; value < 256; ++value)
-       ANYOF_BITMAP_SET(cl, value);
+    ANYOF_BITMAP_SETALL(cl);
     cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL;
     if (LOC)
        cl->flags |= ANYOF_LOCALE;
@@ -543,9 +540,8 @@ S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl)
            return 1;
     if (!(cl->flags & ANYOF_UNICODE_ALL))
        return 0;
-    for (value = 0; value < 256; ++value)
-       if (!ANYOF_BITMAP_TEST(cl, value))
-           return 0;
+    if (!ANYOF_BITMAP_TESTALLSET(cl))
+       return 0;
     return 1;
 }
 
@@ -662,6 +658,17 @@ S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, str
     }
 }
 
+/*
+ * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
+ * These need to be revisited when a newer toolchain becomes available.
+ */
+#if defined(__sparc64__) && defined(__GNUC__)
+#   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
+#       undef  SPARC64_GCC_WORKAROUND
+#       define SPARC64_GCC_WORKAROUND 1
+#   endif
+#endif
+
 /* REx optimizer.  Converts nodes into quickier variants "in place".
    Finds fixed substrings.  */
 
@@ -1207,11 +1214,28 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                    int counted = mincount != 0;
 
                    if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
+#if defined(SPARC64_GCC_WORKAROUND)
+                       I32 b = 0;
+                       STRLEN l = 0;
+                       char *s = NULL;
+                       I32 old = 0;
+
+                       if (pos_before >= data->last_start_min)
+                           b = pos_before;
+                       else
+                           b = data->last_start_min;
+
+                       l = 0;
+                       s = SvPV(data->last_found, l);
+                       old = b - data->last_start_min;
+
+#else
                        I32 b = pos_before >= data->last_start_min
                            ? pos_before : data->last_start_min;
                        STRLEN l;
                        char *s = SvPV(data->last_found, l);
                        I32 old = b - data->last_start_min;
+#endif
 
                        if (UTF)
                            old = utf8_hop((U8*)s, old) - (U8*)s;
@@ -1666,17 +1690,15 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     if (exp == NULL)
        FAIL("NULL regexp argument");
 
-    /* XXXX This looks very suspicious... */
-    if (pm->op_pmdynflags & PMdf_CMP_UTF8)
-        RExC_utf8 = 1;
-    else
-        RExC_utf8 = 0;
+    RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
 
     RExC_precomp = exp;
-    DEBUG_r(if (!PL_colorset) reginitcolors());
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
-                     PL_colors[4],PL_colors[5],PL_colors[0],
-                     (int)(xend - exp), RExC_precomp, PL_colors[1]));
+    DEBUG_r({
+        if (!PL_colorset) reginitcolors();
+        PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
+                      PL_colors[4],PL_colors[5],PL_colors[0],
+                      (int)(xend - exp), RExC_precomp, PL_colors[1]);
+    });
     RExC_flags16 = pm->op_pmflags;
     RExC_sawback = 0;
 
@@ -1764,7 +1786,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
     pm->op_pmflags = RExC_flags16;
     if (UTF)
-       r->reganch |= ROPT_UTF8;
+        r->reganch |= ROPT_UTF8;       /* Unicode in it? */
     r->regstclass = NULL;
     if (RExC_naughty >= 10)    /* Probably an expensive pattern. */
        r->reganch |= ROPT_NAUGHTY;
@@ -2795,6 +2817,7 @@ tryagain:
        case 'Z':
            ret = reg_node(pRExC_state, SEOL);
            *flagp |= SIMPLE;
+           RExC_seen_zerolen++;                /* Do not optimize RE away */
            nextchar(pRExC_state);
            break;
        case 'z':
@@ -2963,7 +2986,7 @@ tryagain:
            char *oldp, *s;
            STRLEN numlen;
            STRLEN ulen;
-           U8 tmpbuf[UTF8_MAXLEN*2+1];
+           U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
 
             parse_start = RExC_parse - 1;
 
@@ -2994,6 +3017,8 @@ tryagain:
                case '\\':
                    switch (*++p) {
                    case 'A':
+                   case 'C':
+                   case 'X':
                    case 'G':
                    case 'Z':
                    case 'z':
@@ -3155,6 +3180,22 @@ tryagain:
        break;
     }
 
+    if (PL_encoding && PL_regkind[(U8)OP(ret)] == EXACT && !RExC_utf8) {
+        STRLEN oldlen = STR_LEN(ret);
+        SV *sv        = sv_2mortal(newSVpvn(STRING(ret), oldlen));
+        char *s       = Perl_sv_recode_to_utf8(aTHX_ sv, PL_encoding);
+        STRLEN newlen = SvCUR(sv);
+        if (!SIZE_ONLY) {
+             DEBUG_r(PerlIO_printf(Perl_debug_log, "recode %*s to %*s\n",
+                                   (int)oldlen, STRING(ret), (int)newlen, s));
+             Copy(s, STRING(ret), newlen, char);
+             STR_LEN(ret) += newlen - oldlen;
+             RExC_emit += STR_SZ(newlen) - STR_SZ(oldlen);
+        } else
+             RExC_size += STR_SZ(newlen) - STR_SZ(oldlen);
+        RExC_utf8 = 1;
+    }
+
     return(ret);
 }
 
@@ -3926,10 +3967,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
                }
                else
 #endif
-                   for (i = prevvalue; i <= ceilvalue; i++)
-                       ANYOF_BITMAP_SET(ret, i);
+                     for (i = prevvalue; i <= ceilvalue; i++)
+                         ANYOF_BITMAP_SET(ret, i);
          }
-         if (value > 255) {
+         if (value > 255 || UTF) {
                ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
                if (prevvalue < value)
                    Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n",
@@ -4415,7 +4456,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 
     if (k == EXACT) {
         SV *dsv = sv_2mortal(newSVpvn("", 0));
-       bool do_utf8 = PL_reg_match_utf8;
+       bool do_utf8 = DO_UTF8(sv);
        char *s    = do_utf8 ?
          pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60, 0) :
          STRING(o);