The same problem with To{Lower,Title,Upper}

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

diff --git a/regcomp.c b/regcomp.c
index e81bc0a..d7ae068 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -4039,7 +4039,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
                                   * [ABCDEF] -> (?:[ABCabcDEFd]|pq|rst)
                                   * where E folds into "pq" and F folds
                                   * into "rst", all other characters
-                                  * fold to single characters. */
+                                  * fold to single characters.  We save
+                                  * away these multicharacter foldings,
+                                  * to be later saved as part of the
+                                  * additional "s" data. */
                                  SV *sv;
 
                                  if (!unicode_alternate)
@@ -4112,6 +4115,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
        AV *av = newAV();
        SV *rv;
 
+       /* The 0th element stores the character class description
+        * in its textual form: used later (regexec.c:Perl_regclass_swatch())
+        * to initialize the appropriate swash (which gets stored in
+        * the 1st element), and also useful for dumping the regnode.
+        * The 2nd element stores the multicharacter foldings,
+        * used later (regexec.c:s_reginclasslen()). */
        av_store(av, 0, listsv);
        av_store(av, 1, NULL);
        av_store(av, 2, (SV*)unicode_alternate);
@@ -4733,16 +4742,26 @@ Perl_re_intuit_string(pTHX_ regexp *prog)
 void
 Perl_pregfree(pTHX_ struct regexp *r)
 {
-    DEBUG_r(if (!PL_colorset) reginitcolors());
+#ifdef DEBUGGING
+    SV *dsv = PERL_DEBUG_PAD_ZERO(0);
+#endif
 
     if (!r || (--r->refcnt > 0))
        return;
-    DEBUG_r(PerlIO_printf(Perl_debug_log,
-                     "%sFreeing REx:%s `%s%.60s%s%s'\n",
-                     PL_colors[4],PL_colors[5],PL_colors[0],
-                     r->precomp,
-                     PL_colors[1],
-                     (strlen(r->precomp) > 60 ? "..." : "")));
+    DEBUG_r({
+         bool utf8 = r->reganch & ROPT_UTF8;
+         char *s = pv_uni_display(dsv, (U8*)r->precomp, r->prelen, 60,
+                                 UNI_DISPLAY_ISPRINT);
+        int len = SvCUR(dsv);
+        if (!PL_colorset)
+             reginitcolors();
+        PerlIO_printf(Perl_debug_log,
+                      "%sFreeing REx:%s `%s%*.*s%s%s'\n",
+                      PL_colors[4],PL_colors[5],PL_colors[0],
+                      len, len, s,
+                      PL_colors[1],
+                      len > 60 ? "..." : "");
+    });
 
     if (r->precomp)
        Safefree(r->precomp);