Integrate Memoize 0.64. Few tweaks were required in

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

diff --git a/regcomp.c b/regcomp.c
index 98cf21b..3241444 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -393,6 +393,14 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                 m, (int)offset, RExC_precomp, RExC_precomp + offset);          \
     } STMT_END                                                               \
 
+#define        vWARNdep(loc,m)                                                         \
+    STMT_START {                                                             \
+        unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));          \
+        int warn_cat = ckWARN(WARN_REGEXP) ? WARN_REGEXP : WARN_DEPRECATED;  \
+       Perl_warner(aTHX_ warn_cat, "%s" REPORT_LOCATION,\
+                m, (int)offset, RExC_precomp, RExC_precomp + offset);          \
+    } STMT_END                                                               \
+
 
 #define        vWARN2(loc, m, a1)                                                   \
     STMT_START {                                                             \
@@ -418,9 +426,18 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                 (int)offset, RExC_precomp, RExC_precomp + offset);        \
     } STMT_END
 
+/* used for the parse_flags section for (?c) -- japhy */
+#define        vWARN5(loc, m, a1, a2, a3, a4)                                       \
+  STMT_START {                                                   \
+      unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));   \
+        Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,      \
+                 a1, a2, a3, a4,                                 \
+                 (int)offset, RExC_precomp, RExC_precomp + offset);  \
+    } STMT_END
+
 
 /* Allow for side effects in s */
-#define REGC(c,s) STMT_START { if (!SIZE_ONLY) *(s) = (c); else (s);} STMT_END
+#define REGC(c,s) STMT_START { if (!SIZE_ONLY) *(s) = (c); else (void)(s);} STMT_END
 
 /* Macros for recording node offsets.   20001227 mjd@plover.com 
  * Nodes are numbered 1, 2, 3, 4.  Node #n's position is recorded in
@@ -2018,12 +2035,23 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
     register regnode *ender = 0;
     register I32 parno = 0;
     I32 flags, oregflags = RExC_flags16, have_branch = 0, open = 0;
+
+    /* for (?g), (?gc), and (?o) warnings; warning
+       about (?c) will warn about (?g) -- japhy    */
+
+    I32 wastedflags = 0x00,
+        wasted_o    = 0x01,
+        wasted_g    = 0x02,
+        wasted_gc   = 0x02 | 0x04,
+        wasted_c    = 0x04;
+
     char * parse_start = RExC_parse; /* MJD */
     char *oregcomp_parse = RExC_parse;
     char c;
 
     *flagp = 0;                                /* Tentatively. */
 
+
     /* Make an OPEN node, if parenthesized. */
     if (paren) {
        if (*RExC_parse == '?') { /* (?...) */
@@ -2062,8 +2090,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                *flagp = TRYAGAIN;
                return NULL;
            case 'p':           /* (?p...) */
-               if (SIZE_ONLY)
-                   vWARN(RExC_parse, "(?p{}) is deprecated - use (??{})");
+               if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP))
+                   vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})");
                /* FALL THROUGH*/
            case '?':           /* (??...) */
                logical = 1;
@@ -2202,12 +2230,45 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                --RExC_parse;
              parse_flags:      /* (?i) */
                while (*RExC_parse && strchr("iogcmsx", *RExC_parse)) {
-                   if (*RExC_parse != 'o')
-                       pmflag(flagsp, *RExC_parse);
+                   /* (?g), (?gc) and (?o) are useless here
+                      and must be globally applied -- japhy */
+
+                   if (*RExC_parse == 'o' || *RExC_parse == 'g') {
+                       if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
+                           I32 wflagbit = *RExC_parse == 'o' ? wasted_o : wasted_g;
+                           if (! (wastedflags & wflagbit) ) {
+                               wastedflags |= wflagbit;
+                               vWARN5(
+                                   RExC_parse + 1,
+                                   "Useless (%s%c) - %suse /%c modifier",
+                                   flagsp == &negflags ? "?-" : "?",
+                                   *RExC_parse,
+                                   flagsp == &negflags ? "don't " : "",
+                                   *RExC_parse
+                               );
+                           }
+                       }
+                   }
+                   else if (*RExC_parse == 'c') {
+                       if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
+                           if (! (wastedflags & wasted_c) ) {
+                               wastedflags |= wasted_gc;
+                               vWARN3(
+                                   RExC_parse + 1,
+                                   "Useless (%sc) - %suse /gc modifier",
+                                   flagsp == &negflags ? "?-" : "?",
+                                   flagsp == &negflags ? "don't " : ""
+                               );
+                           }
+                       }
+                   }
+                   else { pmflag(flagsp, *RExC_parse); }
+
                    ++RExC_parse;
                }
                if (*RExC_parse == '-') {
                    flagsp = &negflags;
+                   wastedflags = 0;  /* reset so (?g-c) warns twice */
                    ++RExC_parse;
                    goto parse_flags;
                }
@@ -4122,10 +4183,11 @@ S_regcurly(pTHX_ register char *s)
 }
 
 
+#ifdef DEBUGGING
+
 STATIC regnode *
 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;
 
@@ -4191,10 +4253,11 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
        else if (op == WHILEM)
            l--;
     }
-#endif /* DEBUGGING */
     return node;
 }
 
+#endif /* DEBUGGING */
+
 /*
  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
  */
@@ -4275,6 +4338,8 @@ Perl_regdump(pTHX_ regexp *r)
 #endif /* DEBUGGING */
 }
 
+#ifdef DEBUGGING
+
 STATIC void
 S_put_byte(pTHX_ SV *sv, int c)
 {
@@ -4286,6 +4351,8 @@ S_put_byte(pTHX_ SV *sv, int c)
        Perl_sv_catpvf(aTHX_ sv, "%c", c);
 }
 
+#endif /* DEBUGGING */
+
 /*
 - regprop - printable representation of opcode
 */