The exact error message is system-dependent.

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

diff --git a/regcomp.c b/regcomp.c
index 2e37633..4b07fd2 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -83,11 +83,7 @@
 #define PERL_IN_REGCOMP_C
 #include "perl.h"
 
-#ifdef PERL_IN_XSUB_RE
-#  if defined(PERL_CAPI) || defined(PERL_OBJECT)
-#    include "XSUB.h"
-#  endif
-#else
+#ifndef PERL_IN_XSUB_RE
 #  include "INTERN.h"
 #endif
 
@@ -483,7 +479,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 #define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
 #define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
 
-static void clear_re(pTHXo_ void *r);
+static void clear_re(pTHX_ void *r);
 
 /* Mark that we cannot extend a found fixed substring at this point.
    Updata the longest found anchored substring and the longest found
@@ -971,6 +967,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
            regnode *oscan = scan;
            struct regnode_charclass_class this_class;
            struct regnode_charclass_class *oclass = NULL;
+           I32 next_is_eval = 0;
 
            switch (PL_regkind[(U8)OP(scan)]) {
            case WHILEM:                /* End of (?:...)* . */
@@ -1016,6 +1013,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                    scan->flags = ((lp <= U8_MAX) ? lp : U8_MAX);
                }
                scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
+               next_is_eval = (OP(scan) == EVAL);
              do_curly:
                if (flags & SCF_DO_SUBSTR) {
                    if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
@@ -1077,6 +1075,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                if (!scan)              /* It was not CURLYX, but CURLY. */
                    scan = next;
                if (ckWARN(WARN_REGEXP)
+                      /* ? quantifier ok, except for (?{ ... }) */
+                   && (next_is_eval || !(mincount == 0 && maxcount == 1))
                    && (minnext == 0) && (deltanext == 0)
                    && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
                    && maxcount <= REG_INFTY/3) /* Complement check for big count */
@@ -1746,6 +1746,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     RExC_rx = r;
 
     /* Second pass: emit code. */
+    RExC_flags16 = pm->op_pmflags;     /* don't let top level (?i) bleed */
     RExC_parse = exp;
     RExC_end = xend;
     RExC_naughty = 0;
@@ -3038,8 +3039,9 @@ tryagain:
                                vFAIL("Missing right brace on \\x{}");
                            }
                            else {
-                               numlen = 1;     /* allow underscores */
-                               ender = (UV)scan_hex(p + 1, e - p - 1, &numlen);
+                                I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
+                                numlen = e - p - 1;
+                               ender = grok_hex(p + 1, &numlen, &flags, NULL);
                                if (ender > 0xff)
                                    RExC_utf8 = 1;
                                /* numlen is generous */
@@ -3051,8 +3053,9 @@ tryagain:
                            }
                        }
                        else {
-                           numlen = 0;         /* disallow underscores */
-                           ender = (UV)scan_hex(p, 2, &numlen);
+                            I32 flags = 0;
+                           numlen = 2;
+                           ender = grok_hex(p, &numlen, &flags, NULL);
                            p += numlen;
                        }
                        break;
@@ -3065,8 +3068,9 @@ tryagain:
                    case '5': case '6': case '7': case '8':case '9':
                        if (*p == '0' ||
                          (isDIGIT(p[1]) && atoi(p) >= RExC_npar) ) {
-                           numlen = 0;         /* disallow underscores */
-                           ender = (UV)scan_oct(p, 3, &numlen);
+                            I32 flags = 0;
+                           numlen = 3;
+                           ender = grok_oct(p, &numlen, &flags, NULL);
                            p += numlen;
                        }
                        else {
@@ -3445,18 +3449,19 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
            case 'a':   value = ASCII_TO_NATIVE('\007');break;
            case 'x':
                if (*RExC_parse == '{') {
+                    I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
                    e = strchr(RExC_parse++, '}');
                     if (!e)
                         vFAIL("Missing right brace on \\x{}");
-                   numlen = 1;         /* allow underscores */
-                   value = (UV)scan_hex(RExC_parse,
-                                        e - RExC_parse,
-                                        &numlen);
+
+                   numlen = e - RExC_parse;
+                   value = grok_hex(RExC_parse, &numlen, &flags, NULL);
                    RExC_parse = e + 1;
                }
                else {
-                   numlen = 0;         /* disallow underscores */
-                   value = (UV)scan_hex(RExC_parse, 2, &numlen);
+                    I32 flags = 0;
+                   numlen = 2;
+                   value = grok_hex(RExC_parse, &numlen, &flags, NULL);
                    RExC_parse += numlen;
                }
                break;
@@ -3466,10 +3471,13 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
                break;
            case '0': case '1': case '2': case '3': case '4':
            case '5': case '6': case '7': case '8': case '9':
-               numlen = 0;             /* disallow underscores */
-               value = (UV)scan_oct(--RExC_parse, 3, &numlen);
+            {
+                I32 flags = 0;
+               numlen = 3;
+               value = grok_oct(--RExC_parse, &numlen, &flags, NULL);
                RExC_parse += numlen;
                break;
+            }
            default:
                if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
                    vWARN2(RExC_parse,
@@ -4734,6 +4742,7 @@ Perl_save_re_context(pTHX)
     SAVEVPTR(PL_reg_re);               /* from regexec.c */
     SAVEPPTR(PL_reg_ganch);            /* from regexec.c */
     SAVESPTR(PL_reg_sv);               /* from regexec.c */
+    SAVEI8(PL_reg_match_utf8);         /* from regexec.c */
     SAVEVPTR(PL_reg_magic);            /* from regexec.c */
     SAVEI32(PL_reg_oldpos);                    /* from regexec.c */
     SAVEVPTR(PL_reg_oldcurpm);         /* from regexec.c */
@@ -4745,14 +4754,8 @@ Perl_save_re_context(pTHX)
 #endif
 }
 
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#undef this
-#define this pPerl
-#endif
-
 static void
-clear_re(pTHXo_ void *r)
+clear_re(pTHX_ void *r)
 {
     ReREFCNT_dec((regexp *)r);
 }