Fix for ID 20000828.001, long doubles were not formatted
[p5sagit/p5-mst-13.2.git] / regcomp.c
index fd4633b..723cbbe 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -210,19 +210,19 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
  * op/pragma/warn/regcomp.
  */
-#define MARKER1 "<HERE<"      /* marker as it appears in the description */
-#define MARKER2 " <<<HERE<<< "  /* marker as it appears within the regex */
+#define MARKER1 "HERE"      /* marker as it appears in the description */
+#define MARKER2 " << HERE "  /* marker as it appears within the regex */
    
-#define REPORT_LOCATION " at " MARKER1 " mark in regex m/%.*s" MARKER2 "%s/"
+#define REPORT_LOCATION " before " MARKER1 " mark in regex m/%.*s" MARKER2 "%s/"
 
 /*
  * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
  * arg. Show regex, up to a maximum length. If it's too long, chop and add
  * "...".
  */
-#define        FAIL(m)                                                              \
+#define        FAIL(msg)                                                             \
     STMT_START {                                                             \
-        char *elipises = "";                                                 \
+        char *ellipses = "";                                                 \
         unsigned len = strlen(PL_regprecomp);                                \
                                                                              \
        if (!SIZE_ONLY)                                                      \
@@ -231,10 +231,10 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
        if (len > RegexLengthToShowInErrorMessages) {                        \
             /* chop 10 shorter than the max, to ensure meaning of "..." */   \
            len = RegexLengthToShowInErrorMessages - 10;                     \
-           elipises = "...";                                                \
+           ellipses = "...";                                                \
        }                                                                    \
        Perl_croak(aTHX_ "%s in regex m/%.*s%s/",                            \
-                  m, len, PL_regprecomp, elipises);                         \
+                  msg, len, PL_regprecomp, ellipses);                        \
     } STMT_END
 
 /*
@@ -242,9 +242,9 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  * args. Show regex, up to a maximum length. If it's too long, chop and add
  * "...".
  */
-#define        FAIL2(pat,m)                                                         \
+#define        FAIL2(pat,msg)                                                        \
     STMT_START {                                                             \
-        char *elipises = "";                                                 \
+        char *ellipses = "";                                                 \
         unsigned len = strlen(PL_regprecomp);                                \
                                                                              \
        if (!SIZE_ONLY)                                                      \
@@ -253,10 +253,10 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
        if (len > RegexLengthToShowInErrorMessages) {                        \
             /* chop 10 shorter than the max, to ensure meaning of "..." */   \
            len = RegexLengthToShowInErrorMessages - 10;                     \
-           elipises = "...";                                                \
+           ellipses = "...";                                                \
        }                                                                    \
        S_re_croak2(aTHX_ pat, " in regex m/%.*s%s/",                        \
-                   m, len, PL_regprecomp, elipises);                        \
+                   msg, len, PL_regprecomp, ellipses);                     \
     } STMT_END
 
 
@@ -443,7 +443,7 @@ S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl)
 {
     int value;
 
-    for (value = 0; value < ANYOF_MAX; value += 2)
+    for (value = 0; value <= ANYOF_MAX; value += 2)
        if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
            return 1;
     for (value = 0; value < 256; ++value)
@@ -2190,14 +2190,14 @@ S_reg(pTHX_ I32 paren, I32 *flagp)
     if (paren) {
        PL_regflags = oregflags;
        if (PL_regcomp_parse >= PL_regxend || *nextchar() != ')') {
-           PL_regcomp_parse++;
-           vFAIL("Unmatched (");
+           PL_regcomp_parse = oregcomp_parse;
+           vFAIL("Unmatched (");
        }
     }
     else if (!paren && PL_regcomp_parse < PL_regxend) {
        if (*PL_regcomp_parse == ')') {
-           PL_regcomp_parse = oregcomp_parse;
-           vFAIL("Unmatched (");
+           PL_regcomp_parse++;
+           vFAIL("Unmatched )");
        }
        else
            FAIL("Junk on end of regexp");      /* "Can't happen". */
@@ -2468,9 +2468,9 @@ tryagain:
            ret = reg_node(BOL);
        break;
     case '$':
-       if (PL_regcomp_parse[1]) 
-           PL_seen_zerolen++;
        nextchar();
+       if (*PL_regcomp_parse) 
+           PL_seen_zerolen++;
        if (PL_regflags & PMf_MULTILINE)
            ret = reg_node(MEOL);
        else if (PL_regflags & PMf_SINGLELINE)
@@ -2704,8 +2704,8 @@ tryagain:
                if (num > 9 && num >= PL_regnpar)
                    goto defchar;
                else {
-                   while (isDIGIT(*PL_regcomp_parse))
-                       PL_regcomp_parse++;
+                   while (isDIGIT(*PL_regcomp_parse))
+                       PL_regcomp_parse++;
 
                    if (!SIZE_ONLY && num > PL_regcomp_rx->nparens)
                        vFAIL("Reference to nonexistent group");
@@ -3004,6 +3004,11 @@ S_regpposixcc(pTHX_ I32 value)
                            namedclass =
                                complement ? ANYOF_NASCII : ANYOF_ASCII;
                        break;
+                   case 'b':
+                       if (strnEQ(posixcc, "blank", 5))
+                           namedclass =
+                               complement ? ANYOF_NBLANK : ANYOF_BLANK;
+                       break;
                    case 'c':
                        if (strnEQ(posixcc, "cntrl", 5))
                            namedclass =
@@ -3035,7 +3040,7 @@ S_regpposixcc(pTHX_ I32 value)
                    case 's':
                        if (strnEQ(posixcc, "space", 5))
                            namedclass =
-                               complement ? ANYOF_NSPACE : ANYOF_SPACE;
+                               complement ? ANYOF_NPSXSPC : ANYOF_PSXSPC;
                        break;
                    case 'u':
                        if (strnEQ(posixcc, "upper", 5))
@@ -3160,7 +3165,7 @@ S_regclass(pTHX)
        else if (value == '\\') {
            value = UCHARAT(PL_regcomp_parse++);
            /* Some compilers cannot handle switching on 64-bit integer
-            * values, therefore value cannot be an UV. --jhi */
+            * values, therefore the 'value' cannot be an UV. --jhi */
            switch (value) {
            case 'w':   namedclass = ANYOF_ALNUM;       break;
            case 'W':   namedclass = ANYOF_NALNUM;      break;
@@ -3339,6 +3344,24 @@ S_regclass(pTHX)
 #endif /* EBCDIC */
                    }
                    break;
+               case ANYOF_BLANK:
+                   if (LOC)
+                       ANYOF_CLASS_SET(ret, ANYOF_BLANK);
+                   else {
+                       for (value = 0; value < 256; value++)
+                           if (isBLANK(value))
+                               ANYOF_BITMAP_SET(ret, value);
+                   }
+                   break;
+               case ANYOF_NBLANK:
+                   if (LOC)
+                       ANYOF_CLASS_SET(ret, ANYOF_NBLANK);
+                   else {
+                       for (value = 0; value < 256; value++)
+                           if (!isBLANK(value))
+                               ANYOF_BITMAP_SET(ret, value);
+                   }
+                   break;
                case ANYOF_CNTRL:
                    if (LOC)
                        ANYOF_CLASS_SET(ret, ANYOF_CNTRL);
@@ -3412,6 +3435,24 @@ S_regclass(pTHX)
                                ANYOF_BITMAP_SET(ret, value);
                    }
                    break;
+               case ANYOF_PSXSPC:
+                   if (LOC)
+                       ANYOF_CLASS_SET(ret, ANYOF_PSXSPC);
+                   else {
+                       for (value = 0; value < 256; value++)
+                           if (isPSXSPC(value))
+                               ANYOF_BITMAP_SET(ret, value);
+                   }
+                   break;
+               case ANYOF_NPSXSPC:
+                   if (LOC)
+                       ANYOF_CLASS_SET(ret, ANYOF_NPSXSPC);
+                   else {
+                       for (value = 0; value < 256; value++)
+                           if (!isPSXSPC(value))
+                               ANYOF_BITMAP_SET(ret, value);
+                   }
+                   break;
                case ANYOF_PUNCT:
                    if (LOC)
                        ANYOF_CLASS_SET(ret, ANYOF_PUNCT);
@@ -3739,8 +3780,12 @@ S_regclassutf8(pTHX)
                case ANYOF_NPUNCT:
                    Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPunct\n");   break;
                case ANYOF_SPACE:
+               case ANYOF_PSXSPC:
+               case ANYOF_BLANK:
                    Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsSpace\n");   break;
                case ANYOF_NSPACE:
+               case ANYOF_NPSXSPC:
+               case ANYOF_NBLANK:
                    Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsSpace\n");   break;
                case ANYOF_UPPER:
                    Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsUpper\n");   break;
@@ -4193,7 +4238,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
     else if (k == ANYOF) {
        int i, rangestart = -1;
        const char * const out[] = {    /* Should be syncronized with
-                                          a table in regcomp.h */
+                                          ANYOF_ #xdefines in regcomp.h */
            "\\w",
            "\\W",
            "\\s",
@@ -4217,9 +4262,13 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
            "[:punct:]",
            "[:^punct:]",
            "[:upper:]",
-           "[:!upper:]",
+           "[:^upper:]",
            "[:xdigit:]",
-           "[:^xdigit:]"
+           "[:^xdigit:]",
+           "[:space:]",
+           "[:^space:]",
+           "[:blank:]",
+           "[:^blank:]"
        };
 
        if (o->flags & ANYOF_LOCALE)
@@ -4323,8 +4372,13 @@ Perl_pregfree(pTHX_ struct regexp *r)
                    Perl_croak(aTHX_ "panic: pregfree comppad");
                old_comppad = PL_comppad;
                old_curpad = PL_curpad;
-               PL_comppad = new_comppad;
-               PL_curpad = AvARRAY(new_comppad);
+               /* Watch out for global destruction's random ordering. */
+               if (SvTYPE(new_comppad) == SVt_PVAV) {
+                   PL_comppad = new_comppad;
+                   PL_curpad = AvARRAY(new_comppad);
+               }
+               else
+                   PL_curpad = NULL;
                op_free((OP_4tree*)r->data->data[n]);
                PL_comppad = old_comppad;
                PL_curpad = old_curpad;