Various changes to regex diagnostics and testing

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

diff --git a/regcomp.c b/regcomp.c
index 6d3da0f..fba4260 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6617,20 +6617,30 @@ S_reg_namedseq(pTHX_ RExC_state_t *pRExC_state, UV *valuep)
             | PERL_SCAN_DISALLOW_PREFIX
             | (SIZE_ONLY ? PERL_SCAN_SILENT_ILLDIGIT : 0);
         UV cp;
-       char string;
         len = (STRLEN)(endbrace - name - 2);
         cp = grok_hex(name + 2, &len, &fl, NULL);
         if ( len != (STRLEN)(endbrace - name - 2) ) {
             cp = 0xFFFD;
         }    
-        if (cp > 0xff)
-            RExC_utf8 = 1;
         if ( valuep ) {
+           if (cp > 0xff) RExC_utf8 = 1;
             *valuep = cp;
             return NULL;
         }
-       string = (char)cp;
-        sv_str= newSVpvn(&string, 1);
+
+       /* Need to convert to utf8 if either: won't fit into a byte, or the re
+        * is going to be in utf8 and the representation changes under utf8. */
+       if (cp > 0xff || (RExC_utf8 && ! UNI_IS_INVARIANT(cp))) {
+           U8 string[UTF8_MAXBYTES+1];
+           U8 *tmps;
+           RExC_utf8 = 1;
+           tmps = uvuni_to_utf8(string, cp);
+           sv_str = newSVpvn_utf8((char*)string, tmps - string, TRUE);
+       } else {    /* Otherwise, no need for utf8, can skip that step */
+           char string;
+           string = (char)cp;
+           sv_str= newSVpvn(&string, 1);
+       }
     } else {
         /* fetch the charnames handler for this scope */
         HV * const table = GvHV(PL_hintgv);
@@ -6809,7 +6819,7 @@ S_reg_namedseq(pTHX_ RExC_state_t *pRExC_state, UV *valuep)
         Set_Node_Cur_Length(ret); /* MJD */
         RExC_parse--; 
         nextchar(pRExC_state);
-    } else {
+    } else {   /* zero length */
         ret = reg_node(pRExC_state,NOTHING);
     }
     if (!cached) {
@@ -9089,6 +9099,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
     else if (k == ANYOF) {
        int i, rangestart = -1;
        const U8 flags = ANYOF_FLAGS(o);
+       int do_sep = 0;
 
        /* Should be synchronized with * ANYOF_ #xdefines in regcomp.h */
        static const char * const anyofs[] = {
@@ -9104,8 +9115,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
            "[:^alpha:]",
            "[:ascii:]",
            "[:^ascii:]",
-           "[:ctrl:]",
-           "[:^ctrl:]",
+           "[:cntrl:]",
+           "[:^cntrl:]",
            "[:graph:]",
            "[:^graph:]",
            "[:lower:]",
@@ -9144,14 +9155,26 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
                    sv_catpvs(sv, "-");
                    put_byte(sv, i - 1);
                }
+               do_sep = 1;
                rangestart = -1;
            }
        }
-
+        if (do_sep) {
+            sv_catpvs(sv,"][");
+            do_sep = 0;
+        }
+            
        if (o->flags & ANYOF_CLASS)
            for (i = 0; i < (int)(sizeof(anyofs)/sizeof(char*)); i++)
-               if (ANYOF_CLASS_TEST(o,i))
+               if (ANYOF_CLASS_TEST(o,i)) {
                    sv_catpv(sv, anyofs[i]);
+                   do_sep = 1;
+               }
+        
+        if (do_sep) {
+            sv_catpvs(sv,"][");
+            do_sep = 0;
+        }
 
        if (flags & ANYOF_UNICODE)
            sv_catpvs(sv, "{unicode}");
@@ -9165,7 +9188,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
            if (lv) {
                if (sw) {
                    U8 s[UTF8_MAXBYTES_CASE+1];
-               
+
                    for (i = 0; i <= 256; i++) { /* just the first 256 */
                        uvchr_to_utf8(s, i);