This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Pod::Man generates groff-incompatible macro definition (from
[perl5.git] / regcomp.c
diff --git a/regcomp.c b/regcomp.c
index 5df82c0..7af090e 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -277,6 +277,7 @@ S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl)
 STATIC void
 S_cl_init(pTHX_ struct regnode_charclass_class *cl)
 {
+    Zero(cl, 1, struct regnode_charclass_class);
     cl->type = ANYOF;
     cl_anything(cl);
 }
@@ -284,10 +285,9 @@ S_cl_init(pTHX_ struct regnode_charclass_class *cl)
 STATIC void
 S_cl_init_zero(pTHX_ struct regnode_charclass_class *cl)
 {
+    Zero(cl, 1, struct regnode_charclass_class);
     cl->type = ANYOF;
     cl_anything(cl);
-    ANYOF_CLASS_ZERO(cl);
-    ANYOF_BITMAP_ZERO(cl);
     if (LOC)
        cl->flags |= ANYOF_LOCALE;
 }
@@ -298,8 +298,6 @@ STATIC void
 S_cl_and(pTHX_ struct regnode_charclass_class *cl,
         struct regnode_charclass_class *and_with)
 {
-    int value;
-
     if (!(and_with->flags & ANYOF_CLASS)
        && !(cl->flags & ANYOF_CLASS)
        && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
@@ -323,8 +321,6 @@ S_cl_and(pTHX_ struct regnode_charclass_class *cl,
 STATIC void
 S_cl_or(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with)
 {
-    int value;
-
     if (or_with->flags & ANYOF_INVERT) {
        /* We do not use
         * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
@@ -602,7 +598,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
                    && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan))
                    && (!(data->start_class->flags & ANYOF_FOLD)
                        || !ANYOF_BITMAP_TEST(data->start_class,
-                                             PL_fold[*STRING(scan)])))
+                                             PL_fold[*(U8*)STRING(scan)])))
                    compat = 0;
                ANYOF_CLASS_ZERO(data->start_class);
                ANYOF_BITMAP_ZERO(data->start_class);
@@ -644,7 +640,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
                if (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE)) 
                    && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan))
                    && !ANYOF_BITMAP_TEST(data->start_class, 
-                                         PL_fold[*STRING(scan)]))
+                                         PL_fold[*(U8*)STRING(scan)]))
                    compat = 0;
                ANYOF_CLASS_ZERO(data->start_class);
                ANYOF_BITMAP_ZERO(data->start_class);
@@ -765,15 +761,15 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
                }
                if (!scan)              /* It was not CURLYX, but CURLY. */
                    scan = next;
-               if (ckWARN(WARN_UNSAFE) && (minnext + deltanext == 0) 
+               if (ckWARN(WARN_REGEXP) && (minnext + deltanext == 0) 
                    && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
                    && maxcount <= REG_INFTY/3) /* Complement check for big count */
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+                   Perl_warner(aTHX_ WARN_REGEXP,
                                "Strange *+?{} on zero-length expression");
                min += minnext * mincount;
-               is_inf_internal |= (maxcount == REG_INFTY 
-                                   && (minnext + deltanext) > 0
-                                  || deltanext == I32_MAX);
+               is_inf_internal |= ((maxcount == REG_INFTY 
+                                    && (minnext + deltanext) > 0)
+                                   || deltanext == I32_MAX);
                is_inf |= is_inf_internal;
                delta += (minnext + deltanext) * maxcount - minnext * mincount;
 
@@ -1226,7 +1222,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
                if (data)
                    data->flags |= SF_HAS_EVAL;
        }
-       else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded */
+       else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
                if (flags & SCF_DO_SUBSTR) {
                    scan_commit(data);
                    data->longest = &(data->longest_float);
@@ -1234,6 +1230,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
                is_inf = is_inf_internal = 1;
                if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
                    cl_anything(data->start_class);
+               flags &= ~SCF_DO_STCLASS;
        }
        /* Else: zero-length, ignore. */
        scan = regnext(scan);
@@ -1326,9 +1323,6 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     dTHR;
     register regexp *r;
     regnode *scan;
-    SV **longest;
-    SV *longest_fixed;
-    SV *longest_float;
     regnode *first;
     I32 flags;
     I32 minlen = 0;
@@ -1366,7 +1360,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     PL_regsize = 0L;
     PL_regcode = &PL_regdummy;
     PL_reg_whilem_seen = 0;
+#if 0 /* REGC() is (currently) a NOP at the first pass.
+       * Clever compilers notice this and complain. --jhi */
     REGC((U8)REG_MAGIC, (char*)PL_regcode);
+#endif
     if (reg(0, &flags) == NULL) {
        Safefree(PL_regprecomp);
        PL_regprecomp = Nullch;
@@ -1388,6 +1385,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
         char, regexp);
     if (r == NULL)
        FAIL("regexp out of space");
+#ifdef DEBUGGING
+    /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
+    Zero(r, sizeof(regexp) + (unsigned)PL_regsize * sizeof(regnode), char);
+#endif
     r->refcnt = 1;
     r->prelen = xend - exp;
     r->precomp = PL_regprecomp;
@@ -1731,6 +1732,11 @@ S_reg(pTHX_ I32 paren, I32 *flagp)
                *flagp = TRYAGAIN;
                return NULL;
            case 'p':
+               if (SIZE_ONLY)
+                   Perl_warner(aTHX_ WARN_REGEXP,
+                               "(?p{}) is deprecated - use (??{})");
+               /* FALL THROUGH*/
+           case '?':
                logical = 1;
                paren = *PL_regcomp_parse++;
                /* FALL THROUGH */
@@ -2202,8 +2208,8 @@ S_regpiece(pTHX_ I32 *flagp)
        goto do_curly;
     }
   nest_check:
-    if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
-       Perl_warner(aTHX_ WARN_UNSAFE, "%.*s matches null string many times",
+    if (ckWARN(WARN_REGEXP) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
+       Perl_warner(aTHX_ WARN_REGEXP, "%.*s matches null string many times",
            PL_regcomp_parse - origparse, origparse);
     }
 
@@ -2290,8 +2296,14 @@ tryagain:
        nextchar();
        ret = reg(1, &flags);
        if (ret == NULL) {
-               if (flags & TRYAGAIN)
+               if (flags & TRYAGAIN) {
+                   if (PL_regcomp_parse == PL_regxend) {
+                        /* Make parent create an empty node if needed. */
+                       *flagp |= TRYAGAIN;
+                       return(NULL);
+                   }
                    goto tryagain;
+               }
                return(NULL);
        }
        *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
@@ -2630,8 +2642,8 @@ tryagain:
                            FAIL("trailing \\ in regexp");
                        /* FALL THROUGH */
                    default:
-                       if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(*p))
-                           Perl_warner(aTHX_ WARN_UNSAFE, 
+                       if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p))
+                           Perl_warner(aTHX_ WARN_REGEXP, 
                                        "/%.127s/: Unrecognized escape \\%c passed through",
                                        PL_regprecomp,
                                        *p);
@@ -2816,15 +2828,15 @@ S_regpposixcc(pTHX_ I32 value)
                        }
                        break;
                    }
-                   if ((namedclass == OOB_NAMEDCLASS ||
-                        !(posixcc + skip + 2 < PL_regxend &&
-                          (posixcc[skip] == ':' &&
-                           posixcc[skip + 1] == ']'))))
-                       Perl_croak(aTHX_ "Character class [:%.*s:] unknown",
-                                  t - s - 1, s + 1); 
-               } else if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY)
+                   if (namedclass == OOB_NAMEDCLASS ||
+                       posixcc[skip] != ':' ||
+                       posixcc[skip+1] != ']')
+                       Perl_croak(aTHX_
+                                  "Character class [:%.*s:] unknown",
+                                  t - s - 1, s + 1);
+               } else if (ckWARN(WARN_REGEXP) && !SIZE_ONLY)
                    /* [[=foo=]] and [[.foo.]] are still future. */
-                   Perl_warner(aTHX_ WARN_UNSAFE,
+                   Perl_warner(aTHX_ WARN_REGEXP,
                                "Character class syntax [%c %c] is reserved for future extensions", c, c);
            } else {
                /* Maternal grandfather:
@@ -2840,7 +2852,7 @@ S_regpposixcc(pTHX_ I32 value)
 STATIC void
 S_checkposixcc(pTHX)
 {
-    if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) &&
+    if (!SIZE_ONLY && ckWARN(WARN_REGEXP) &&
        (*PL_regcomp_parse == ':' ||
         *PL_regcomp_parse == '=' ||
         *PL_regcomp_parse == '.')) {
@@ -2850,10 +2862,10 @@ S_checkposixcc(pTHX)
        while(*s && isALNUM(*s))
            s++;
        if (*s && c == *s && s[1] == ']') {
-           Perl_warner(aTHX_ WARN_UNSAFE,
+           Perl_warner(aTHX_ WARN_REGEXP,
                        "Character class syntax [%c %c] belongs inside character classes", c, c);
            if (c == '=' || c == '.')
-               Perl_warner(aTHX_ WARN_UNSAFE,
+               Perl_warner(aTHX_ WARN_REGEXP,
                            "Character class syntax [%c %c] is reserved for future extensions", c, c);
        }
     }
@@ -2863,11 +2875,10 @@ STATIC regnode *
 S_regclass(pTHX)
 {
     dTHR;
-    register UV value;
+    register U32 value;
     register I32 lastvalue = OOB_CHAR8;
     register I32 range = 0;
     register regnode *ret;
-    register I32 def;
     I32 numlen;
     I32 namedclass;
     char *rangebegin;
@@ -2892,7 +2903,7 @@ S_regclass(pTHX)
            ANYOF_FLAGS(ret) |= ANYOF_INVERT;
     }
 
-    if (!SIZE_ONLY && ckWARN(WARN_UNSAFE))
+    if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
        checkposixcc();
 
     if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
@@ -2907,6 +2918,8 @@ S_regclass(pTHX)
            namedclass = regpposixcc(value);
        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 */
            switch (value) {
            case 'w':   namedclass = ANYOF_ALNUM;       break;
            case 'W':   namedclass = ANYOF_NALNUM;      break;
@@ -2940,8 +2953,8 @@ S_regclass(pTHX)
                PL_regcomp_parse += numlen;
                break;
            default:
-               if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(value))
-                   Perl_warner(aTHX_ WARN_UNSAFE, 
+               if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
+                   Perl_warner(aTHX_ WARN_REGEXP, 
                                "/%.127s/: Unrecognized escape \\%c in character class passed through",
                                PL_regprecomp,
                                (int)value);
@@ -2954,8 +2967,8 @@ S_regclass(pTHX)
            need_class = 1;
            if (range) { /* a-\d, a-[:digit:] */
                if (!SIZE_ONLY) {
-                   if (ckWARN(WARN_UNSAFE))
-                       Perl_warner(aTHX_ WARN_UNSAFE,
+                   if (ckWARN(WARN_REGEXP))
+                       Perl_warner(aTHX_ WARN_REGEXP,
                                    "/%.127s/: false [] range \"%*.*s\" in regexp",
                                    PL_regprecomp,
                                    PL_regcomp_parse - rangebegin,
@@ -3239,8 +3252,8 @@ S_regclass(pTHX)
                PL_regcomp_parse[1] != ']') {
                PL_regcomp_parse++;
                if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
-                   if (ckWARN(WARN_UNSAFE))
-                       Perl_warner(aTHX_ WARN_UNSAFE,
+                   if (ckWARN(WARN_REGEXP))
+                       Perl_warner(aTHX_ WARN_REGEXP,
                                    "/%.127s/: false [] range \"%*.*s\" in regexp",
                                    PL_regprecomp,
                                    PL_regcomp_parse - rangebegin,
@@ -3308,7 +3321,7 @@ S_regclassutf8(pTHX)
 {
     dTHR;
     register char *e;
-    register UV value;
+    register U32 value;
     register U32 lastvalue = OOB_UTF8;
     register I32 range = 0;
     register regnode *ret;
@@ -3333,7 +3346,7 @@ S_regclassutf8(pTHX)
        listsv = newSVpvn("# comment\n",10);
     }
 
-    if (!SIZE_ONLY && ckWARN(WARN_UNSAFE))
+    if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
        checkposixcc();
 
     if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
@@ -3349,8 +3362,11 @@ S_regclassutf8(pTHX)
        if (value == '[')
            namedclass = regpposixcc(value);
        else if (value == '\\') {
-           value = utf8_to_uv((U8*)PL_regcomp_parse, &numlen);
+           value = (U32)utf8_to_uv((U8*)PL_regcomp_parse, &numlen);
            PL_regcomp_parse += numlen;
+           /* Some compilers cannot handle switching on 64-bit integer
+            * values, therefore value cannot be an UV.  Yes, this will
+            * be a problem later if we want switch on Unicode.  --jhi */
            switch (value) {
            case 'w':           namedclass = ANYOF_ALNUM;               break;
            case 'W':           namedclass = ANYOF_NALNUM;              break;
@@ -3418,8 +3434,8 @@ S_regclassutf8(pTHX)
                PL_regcomp_parse += numlen;
                break;
            default:
-               if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(value))
-                   Perl_warner(aTHX_ WARN_UNSAFE, 
+               if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
+                   Perl_warner(aTHX_ WARN_REGEXP, 
                                "/%.127s/: Unrecognized escape \\%c in character class passed through",
                                PL_regprecomp,
                                (int)value);
@@ -3429,8 +3445,8 @@ S_regclassutf8(pTHX)
        if (namedclass > OOB_NAMEDCLASS) {
            if (range) { /* a-\d, a-[:digit:] */
                if (!SIZE_ONLY) {
-                   if (ckWARN(WARN_UNSAFE))
-                       Perl_warner(aTHX_ WARN_UNSAFE,
+                   if (ckWARN(WARN_REGEXP))
+                       Perl_warner(aTHX_ WARN_REGEXP,
                                    "/%.127s/: false [] range \"%*.*s\" in regexp",
                                    PL_regprecomp,
                                    PL_regcomp_parse - rangebegin,
@@ -3517,8 +3533,8 @@ S_regclassutf8(pTHX)
                PL_regcomp_parse[1] != ']') {
                PL_regcomp_parse++;
                if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
-                   if (ckWARN(WARN_UNSAFE))
-                       Perl_warner(aTHX_ WARN_UNSAFE,
+                   if (ckWARN(WARN_REGEXP))
+                       Perl_warner(aTHX_ WARN_REGEXP,
                                    "/%.127s/: false [] range \"%*.*s\" in regexp",
                                    PL_regprecomp,
                                    PL_regcomp_parse - rangebegin,
@@ -3642,7 +3658,7 @@ S_reguni(pTHX_ UV uv, char* s, I32* lenp)
 {
     dTHR;
     if (SIZE_ONLY) {
-       U8 tmpbuf[10];
+       U8 tmpbuf[UTF8_MAXLEN];
        *lenp = uv_to_utf8(tmpbuf, uv) - tmpbuf;
     }
     else
@@ -3692,7 +3708,6 @@ S_regtail(pTHX_ regnode *p, regnode *val)
     dTHR;
     register regnode *scan;
     register regnode *temp;
-    register I32 offset;
 
     if (SIZE_ONLY)
        return;
@@ -3761,7 +3776,7 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
 {
 #ifdef DEBUGGING
     register U8 op = EXACT;    /* Arbitrary non-END op. */
-    register regnode *next, *onode;
+    register regnode *next;
 
     while (op != END && (!last || node < last)) {
        /* While that wasn't END last time... */
Unnamed repository; edit this file 'description' to name the repository.