Integrate with Sarathy.

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

diff --git a/regcomp.c b/regcomp.c
index 353155b..77a4bfc 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -545,9 +545,21 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
                    }
                }
                else if (flags & SCF_DO_STCLASS_AND) {
-                   cl_and(data->start_class, &accum);
-                   if (min1)
+                   if (min1) {
+                       cl_and(data->start_class, &accum);
                        flags &= ~SCF_DO_STCLASS;
+                   }
+                   else {
+                       /* Switch to OR mode: cache the old value of 
+                        * data->start_class */
+                       StructCopy(data->start_class, &and_with,
+                                  struct regnode_charclass_class);
+                       flags &= ~SCF_DO_STCLASS_AND;
+                       StructCopy(&accum, data->start_class,
+                                  struct regnode_charclass_class);
+                       flags |= SCF_DO_STCLASS_OR;
+                       data->start_class->flags |= ANYOF_EOS;
+                   }
                }
            }
            else if (code == BRANCHJ)   /* single branch is optimized. */
@@ -1590,7 +1602,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
            DEBUG_r((sv = sv_newmortal(),
                     regprop(sv, (regnode*)data.start_class),
-                    PerlIO_printf(Perl_debug_log, "synthetic stclass.\n",
+                    PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n",
                                   SvPVX(sv))));
        }
 
@@ -1639,7 +1651,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
            DEBUG_r((sv = sv_newmortal(),
                     regprop(sv, (regnode*)data.start_class),
-                    PerlIO_printf(Perl_debug_log, "synthetic stclass.\n",
+                    PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n",
                                   SvPVX(sv))));
        }
     }
@@ -2558,11 +2570,19 @@ tryagain:
                        p++;
                        break;
                    case 'e':
-                       ender = '\033';
+#ifdef ASCIIish
+                         ender = '\033';
+#else
+                         ender = '\047';
+#endif
                        p++;
                        break;
                    case 'a':
-                       ender = '\007';
+#ifdef ASCIIish
+                         ender = '\007';
+#else
+                         ender = '\057';
+#endif
                        p++;
                        break;
                    case 'x':
@@ -2898,8 +2918,13 @@ S_regclass(pTHX)
            case 't':   value = '\t';                   break;
            case 'f':   value = '\f';                   break;
            case 'b':   value = '\b';                   break;
+#ifdef ASCIIish
            case 'e':   value = '\033';                 break;
            case 'a':   value = '\007';                 break;
+#else
+           case 'e':   value = '\047';                 break;
+           case 'a':   value = '\057';                 break;
+#endif
            case 'x':
                value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen);
                PL_regcomp_parse += numlen;
@@ -2918,7 +2943,7 @@ S_regclass(pTHX)
                    Perl_warner(aTHX_ WARN_UNSAFE, 
                                "/%.127s/: Unrecognized escape \\%c in character class passed through",
                                PL_regprecomp,
-                               value);
+                               (int)value);
                break;
            }
        }
@@ -3036,16 +3061,28 @@ S_regclass(pTHX)
                    if (LOC)
                        ANYOF_CLASS_SET(ret, ANYOF_ASCII);
                    else {
+#ifdef ASCIIish
                        for (value = 0; value < 128; value++)
                            ANYOF_BITMAP_SET(ret, value);
+#else  /* EBCDIC */
+                       for (value = 0; value < 256; value++)
+                           if (isASCII(value))
+                               ANYOF_BITMAP_SET(ret, value);
+#endif /* EBCDIC */
                    }
                    break;
                case ANYOF_NASCII:
                    if (LOC)
                        ANYOF_CLASS_SET(ret, ANYOF_NASCII);
                    else {
+#ifdef ASCIIish
                        for (value = 128; value < 256; value++)
                            ANYOF_BITMAP_SET(ret, value);
+#else  /* EBCDIC */
+                       for (value = 0; value < 256; value++)
+                           if (!isASCII(value))
+                               ANYOF_BITMAP_SET(ret, value);
+#endif /* EBCDIC */
                    }
                    break;
                case ANYOF_CNTRL:
@@ -3335,10 +3372,10 @@ S_regclassutf8(pTHX)
                if (!SIZE_ONLY) {
                    if (value == 'p')
                        Perl_sv_catpvf(aTHX_ listsv,
-                                      "+utf8::%.*s\n", n, PL_regcomp_parse);
+                                      "+utf8::%.*s\n", (int)n, PL_regcomp_parse);
                    else
                        Perl_sv_catpvf(aTHX_ listsv,
-                                      "!utf8::%.*s\n", n, PL_regcomp_parse);
+                                      "!utf8::%.*s\n", (int)n, PL_regcomp_parse);
                }
                PL_regcomp_parse = e + 1;
                lastvalue = OOB_UTF8;
@@ -3348,8 +3385,13 @@ S_regclassutf8(pTHX)
            case 't':           value = '\t';           break;
            case 'f':           value = '\f';           break;
            case 'b':           value = '\b';           break;
+#ifdef ASCIIish
            case 'e':           value = '\033';         break;
            case 'a':           value = '\007';         break;
+#else
+           case 'e':           value = '\047';         break;
+           case 'a':           value = '\057';         break;
+#endif
            case 'x':
                if (*PL_regcomp_parse == '{') {
                    e = strchr(PL_regcomp_parse++, '}');
@@ -3379,7 +3421,7 @@ S_regclassutf8(pTHX)
                    Perl_warner(aTHX_ WARN_UNSAFE, 
                                "/%.127s/: Unrecognized escape \\%c in character class passed through",
                                PL_regprecomp,
-                               value);
+                               (int)value);
                break;
            }
        }
@@ -3894,7 +3936,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
     else if (k == WHILEM && o->flags)                  /* Ordinal/of */
        Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4);
     else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP )
-       Perl_sv_catpvf(aTHX_ sv, "%d", ARG(o)); /* Parenth number */
+       Perl_sv_catpvf(aTHX_ sv, "%d", (int)ARG(o));    /* Parenth number */
     else if (k == LOGICAL)
        Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags);     /* 2: embedded, otherwise 1 */
     else if (k == ANYOF) {
@@ -4126,7 +4168,7 @@ Perl_save_re_context(pTHX)
     SAVEVPTR(PL_regendp);              /* Ditto for endp. */
     SAVEVPTR(PL_reglastparen);         /* Similarly for lastparen. */
     SAVEPPTR(PL_regtill);              /* How far we are required to go. */
-    SAVEI32(PL_regprev);               /* char before regbol, \n if none */
+    SAVEI8(PL_regprev);                        /* char before regbol, \n if none */
     SAVEVPTR(PL_reg_start_tmp);                /* from regexec.c */
     PL_reg_start_tmp = 0;
     SAVEFREEPV(PL_reg_start_tmp);