X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7ea3cd407b6ec2a3e424bdfbc486b6e01d6d28bd..e32f01490f26807de0d82fac927cc0dcb0bf3a59:/regcomp.c diff --git a/regcomp.c b/regcomp.c index 8748271..a12f4e1 100644 --- a/regcomp.c +++ b/regcomp.c @@ -40,10 +40,10 @@ /* *These* symbols are masked to allow static link. */ # define Perl_regnext my_regnext # define Perl_save_re_context my_save_re_context -# define Perl_reginitcolors my_reginitcolors +# define Perl_reginitcolors my_reginitcolors # define PERL_NO_GET_CONTEXT -#endif +#endif /*SUPPRESS 112*/ /* @@ -69,7 +69,7 @@ * **** Alterations to Henry's code are... **** - **** Copyright (c) 1991-2000, Larry Wall + **** Copyright (c) 1991-2001, Larry Wall **** **** You may distribute under the terms of either the GNU General Public **** License or the Artistic License, as specified in the README file. @@ -115,9 +115,11 @@ typedef struct RExC_state_t { U16 flags16; /* are we folding, multilining? */ char *precomp; /* uncompiled string. */ regexp *rx; + char *start; /* Start of input for compile */ char *end; /* End of input for compile */ char *parse; /* Input-scan pointer. */ I32 whilem_seen; /* number of WHILEM in this expr */ + regnode *emit_start; /* Start of emitted-code area */ regnode *emit; /* Code-emit pointer; ®dummy = don't = compiling */ I32 naughty; /* How bad is this pattern? */ I32 sawback; /* Did we see \1, ...? */ @@ -127,6 +129,7 @@ typedef struct RExC_state_t { I32 extralen; I32 seen_zerolen; I32 seen_evals; + I32 utf8; #if ADD_TO_REGEXEC char *starttry; /* -Dr: where regtry was called. */ #define RExC_starttry (pRExC_state->starttry) @@ -136,10 +139,13 @@ typedef struct RExC_state_t { #define RExC_flags16 (pRExC_state->flags16) #define RExC_precomp (pRExC_state->precomp) #define RExC_rx (pRExC_state->rx) +#define RExC_start (pRExC_state->start) #define RExC_end (pRExC_state->end) #define RExC_parse (pRExC_state->parse) #define RExC_whilem_seen (pRExC_state->whilem_seen) +#define RExC_offsets (pRExC_state->rx->offsets) /* I am not like the others */ #define RExC_emit (pRExC_state->emit) +#define RExC_emit_start (pRExC_state->emit_start) #define RExC_naughty (pRExC_state->naughty) #define RExC_sawback (pRExC_state->sawback) #define RExC_seen (pRExC_state->seen) @@ -148,15 +154,11 @@ typedef struct RExC_state_t { #define RExC_extralen (pRExC_state->extralen) #define RExC_seen_zerolen (pRExC_state->seen_zerolen) #define RExC_seen_evals (pRExC_state->seen_evals) +#define RExC_utf8 (pRExC_state->utf8) #define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?') #define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \ ((*s) == '{' && regcurly(s))) -#ifdef atarist -#define PERL_META "^$.[()|?+*\\" -#else -#define META "^$.[()|?+*\\" -#endif #ifdef SPSTART #undef SPSTART /* dratted cpp namespace... */ @@ -197,7 +199,7 @@ typedef struct scan_data_t { * Forward declarations for pregcomp()'s friends. */ -static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, +static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; #define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL) @@ -229,8 +231,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR) #define SCF_WHILEM_VISITED_POS 0x2000 -#define RF_utf8 8 -#define UTF (PL_reg_flags & RF_utf8) +#define UTF RExC_utf8 #define LOC (RExC_flags16 & PMf_LOCALE) #define FOLD (RExC_flags16 & PMf_FOLD) @@ -249,10 +250,10 @@ 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 REPORT_LOCATION " before " MARKER1 " mark in regex m/%.*s" MARKER2 "%s/" +#define MARKER1 "<-- HERE" /* marker as it appears in the description */ +#define MARKER2 " <-- HERE " /* marker as it appears within the regex */ + +#define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/" /* * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given @@ -392,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 { \ @@ -417,9 +426,62 @@ 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 + * element 2*n-1 of the array. Element #2n holds the byte length node #n. + * Element 0 holds the number n. + */ + +#define MJD_OFFSET_DEBUG(x) +/* #define MJD_OFFSET_DEBUG(x) fprintf x */ + + +# define Set_Node_Offset_To_R(node,byte) \ + STMT_START { \ + if (! SIZE_ONLY) { \ + if((node) < 0) { \ + Perl_croak(aTHX_ "value of node is %d in Offset macro", node); \ + } else { \ + RExC_offsets[2*(node)-1] = (byte); \ + } \ + } \ + } STMT_END + +# define Set_Node_Offset(node,byte) Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start) +# define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse) + +# define Set_Node_Length_To_R(node,len) \ + STMT_START { \ + if (! SIZE_ONLY) { \ + MJD_OFFSET_DEBUG((stderr, "** (%d) size of node %d is %d.\n", __LINE__, (node), (len))); \ + if((node) < 0) { \ + Perl_croak(aTHX_ "value of node is %d in Length macro", node); \ + } else { \ + RExC_offsets[2*(node)] = (len); \ + } \ + } \ + } STMT_END + +# define Set_Node_Length(node,len) Set_Node_Length_To_R((node)-RExC_emit_start, len) +# define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len) +# define Set_Node_Cur_Length(node) Set_Node_Length(node, RExC_parse - parse_start) + +/* Get offsets and lengths */ +#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); @@ -432,24 +494,24 @@ S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data) { STRLEN l = CHR_SVLEN(data->last_found); STRLEN old_l = CHR_SVLEN(*data->longest); - + if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) { sv_setsv(*data->longest, data->last_found); if (*data->longest == data->longest_fixed) { data->offset_fixed = l ? data->last_start_min : data->pos_min; if (data->flags & SF_BEFORE_EOL) - data->flags + data->flags |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL); else data->flags &= ~SF_FIX_BEFORE_EOL; } else { data->offset_float_min = l ? data->last_start_min : data->pos_min; - data->offset_float_max = (l - ? data->last_start_max + data->offset_float_max = (l + ? data->last_start_max : data->pos_min + data->pos_delta); if (data->flags & SF_BEFORE_EOL) - data->flags + data->flags |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL); else data->flags &= ~SF_FL_BEFORE_EOL; @@ -469,7 +531,7 @@ S_cl_anything(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *c ANYOF_CLASS_ZERO(cl); for (value = 0; value < 256; ++value) ANYOF_BITMAP_SET(cl, value); - cl->flags = ANYOF_EOS; + cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL; if (LOC) cl->flags |= ANYOF_LOCALE; } @@ -483,6 +545,8 @@ S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl) for (value = 0; value <= ANYOF_MAX; value += 2) if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1)) return 1; + if (!(cl->flags & ANYOF_UNICODE_ALL)) + return 0; for (value = 0; value < 256; ++value) if (!ANYOF_BITMAP_TEST(cl, value)) return 0; @@ -530,6 +594,16 @@ S_cl_and(pTHX_ struct regnode_charclass_class *cl, } /* XXXX: logic is complicated otherwise, leave it along for a moment. */ if (!(and_with->flags & ANYOF_EOS)) cl->flags &= ~ANYOF_EOS; + + if (cl->flags & ANYOF_UNICODE_ALL && and_with->flags & ANYOF_UNICODE) { + cl->flags &= ~ANYOF_UNICODE_ALL; + cl->flags |= ANYOF_UNICODE; + ARG_SET(cl, ARG(and_with)); + } + if (!(and_with->flags & ANYOF_UNICODE_ALL)) + cl->flags &= ~ANYOF_UNICODE_ALL; + if (!(and_with->flags & (ANYOF_UNICODE|ANYOF_UNICODE_ALL))) + cl->flags &= ~ANYOF_UNICODE; } /* 'OR' a given class with another one. Can create false positives */ @@ -561,7 +635,7 @@ S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, str } else { /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */ if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE) - && (!(or_with->flags & ANYOF_FOLD) + && (!(or_with->flags & ANYOF_FOLD) || (cl->flags & ANYOF_FOLD)) ) { int i; @@ -580,6 +654,16 @@ S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, str } if (or_with->flags & ANYOF_EOS) cl->flags |= ANYOF_EOS; + + if (cl->flags & ANYOF_UNICODE && or_with->flags & ANYOF_UNICODE && + ARG(cl) != ARG(or_with)) { + cl->flags |= ANYOF_UNICODE_ALL; + cl->flags &= ~ANYOF_UNICODE; + } + if (or_with->flags & ANYOF_UNICODE_ALL) { + cl->flags |= ANYOF_UNICODE_ALL; + cl->flags &= ~ANYOF_UNICODE; + } } /* REx optimizer. Converts nodes into quickier variants "in place". @@ -602,7 +686,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0; scan_data_t data_fake; struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */ - + while (scan && OP(scan) != END && scan < last) { /* Peephole optimizer: */ @@ -612,12 +696,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg U32 stringok = 1; #ifdef DEBUGGING regnode *stop = scan; -#endif +#endif next = scan + NODE_SZ_STR(scan); /* Skip NOTHING, merge EXACT*. */ while (n && - ( PL_regkind[(U8)OP(n)] == NOTHING || + ( PL_regkind[(U8)OP(n)] == NOTHING || (stringok && (OP(n) == OP(scan)))) && NEXT_OFF(n) && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) { @@ -629,25 +713,23 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg #ifdef DEBUGGING if (stringok) stop = n; -#endif +#endif n = regnext(n); } - else { + else if (stringok) { int oldl = STR_LEN(scan); regnode *nnext = regnext(n); - - if (oldl + STR_LEN(n) > U8_MAX) + + if (oldl + STR_LEN(n) > U8_MAX) break; NEXT_OFF(scan) += NEXT_OFF(n); STR_LEN(scan) += STR_LEN(n); next = n + NODE_SZ_STR(n); /* Now we can overwrite *n : */ - Move(STRING(n), STRING(scan) + oldl, - STR_LEN(n), char); + Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char); #ifdef DEBUGGING - if (stringok) - stop = next - 1; -#endif + stop = next - 1; +#endif n = nnext; } } @@ -673,7 +755,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan)); int noff; regnode *n = scan; - + /* Skip NOTHING and LONGJMP. */ while ((n = regnext(n)) && ((PL_regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n))) @@ -682,17 +764,17 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg off += noff; if (reg_off_by_arg[OP(scan)]) ARG(scan) = off; - else + else NEXT_OFF(scan) = off; } /* The principal pseudo-switch. Cannot be a switch, since we look into several different things. */ - if (OP(scan) == BRANCH || OP(scan) == BRANCHJ + if (OP(scan) == BRANCH || OP(scan) == BRANCHJ || OP(scan) == IFTHEN || OP(scan) == SUSPEND) { next = regnext(scan); code = OP(scan); - - if (OP(next) == code || code == IFTHEN || code == SUSPEND) { + + if (OP(next) == code || code == IFTHEN || code == SUSPEND) { I32 max1 = 0, min1 = I32_MAX, num = 0; struct regnode_charclass_class accum; @@ -706,7 +788,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg num++; data_fake.flags = 0; - if (data) { + if (data) { data_fake.whilem_c = data->whilem_c; data_fake.last_closep = data->last_closep; } @@ -720,13 +802,13 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg cl_init(pRExC_state, &this_class); data_fake.start_class = &this_class; f = SCF_DO_STCLASS_AND; - } + } if (flags & SCF_WHILEM_VISITED_POS) f |= SCF_WHILEM_VISITED_POS; /* we suppose the run is continuous, last=next...*/ minnext = study_chunk(pRExC_state, &scan, &deltanext, next, &data_fake, f); - if (min1 > minnext) + if (min1 > minnext) min1 = minnext; if (max1 < minnext + deltanext) max1 = minnext + deltanext; @@ -741,7 +823,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg data->whilem_c = data_fake.whilem_c; if (flags & SCF_DO_STCLASS) cl_or(pRExC_state, &accum, &this_class); - if (code == SUSPEND) + if (code == SUSPEND) break; } if (code == IFTHEN && num < 2) /* Empty ELSE branch */ @@ -767,7 +849,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg flags &= ~SCF_DO_STCLASS; } else { - /* Switch to OR mode: cache the old value of + /* Switch to OR mode: cache the old value of * data->start_class */ StructCopy(data->start_class, &and_with, struct regnode_charclass_class); @@ -787,15 +869,11 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } else if (OP(scan) == EXACT) { I32 l = STR_LEN(scan); + UV uc = *((U8*)STRING(scan)); if (UTF) { - unsigned char *s = (unsigned char *)STRING(scan); - unsigned char *e = s + l; - I32 newl = 0; - while (s < e) { - newl++; - s += UTF8SKIP(s); - } - l = newl; + U8 *s = (U8*)STRING(scan); + l = utf8_length(s, s + l); + uc = utf8_to_uvchr(s, NULL); } min += l; if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */ @@ -804,7 +882,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (data->last_end == -1) { /* Update the start info. */ data->last_start_min = data->pos_min; data->last_start_max = is_inf - ? I32_MAX : data->pos_min + data->pos_delta; + ? I32_MAX : data->pos_min + data->pos_delta; } sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan)); data->last_end = data->pos_min + l; @@ -815,21 +893,27 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg /* Check whether it is compatible with what we know already! */ int compat = 1; - if (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE)) - && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan)) + if (uc >= 0x100 || + (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE)) + && !ANYOF_BITMAP_TEST(data->start_class, uc) && (!(data->start_class->flags & ANYOF_FOLD) - || !ANYOF_BITMAP_TEST(data->start_class, - PL_fold[*(U8*)STRING(scan)]))) + || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc]))) + ) compat = 0; ANYOF_CLASS_ZERO(data->start_class); ANYOF_BITMAP_ZERO(data->start_class); if (compat) - ANYOF_BITMAP_SET(data->start_class, *STRING(scan)); + ANYOF_BITMAP_SET(data->start_class, uc); data->start_class->flags &= ~ANYOF_EOS; + if (uc < 0x100) + data->start_class->flags &= ~ANYOF_UNICODE_ALL; } else if (flags & SCF_DO_STCLASS_OR) { /* false positive possible if the class is case-folded */ - ANYOF_BITMAP_SET(data->start_class, *STRING(scan)); + if (uc < 0x100) + ANYOF_BITMAP_SET(data->start_class, uc); + else + data->start_class->flags |= ANYOF_UNICODE_ALL; data->start_class->flags &= ~ANYOF_EOS; cl_and(data->start_class, &and_with); } @@ -837,19 +921,15 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } else if (PL_regkind[(U8)OP(scan)] == EXACT) { /* But OP != EXACT! */ I32 l = STR_LEN(scan); + UV uc = *((U8*)STRING(scan)); /* Search for fixed substrings supports EXACT only. */ - if (flags & SCF_DO_SUBSTR) + if (flags & SCF_DO_SUBSTR) scan_commit(pRExC_state, data); if (UTF) { - unsigned char *s = (unsigned char *)STRING(scan); - unsigned char *e = s + l; - I32 newl = 0; - while (s < e) { - newl++; - s += UTF8SKIP(s); - } - l = newl; + U8 *s = (U8 *)STRING(scan); + l = utf8_length(s, s + l); + uc = utf8_to_uvchr(s, NULL); } min += l; if (data && (flags & SCF_DO_SUBSTR)) @@ -858,15 +938,15 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg /* Check whether it is compatible with what we know already! */ int compat = 1; - 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[*(U8*)STRING(scan)])) + if (uc >= 0x100 || + (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE)) + && !ANYOF_BITMAP_TEST(data->start_class, uc) + && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc]))) compat = 0; ANYOF_CLASS_ZERO(data->start_class); ANYOF_BITMAP_ZERO(data->start_class); if (compat) { - ANYOF_BITMAP_SET(data->start_class, *STRING(scan)); + ANYOF_BITMAP_SET(data->start_class, uc); data->start_class->flags &= ~ANYOF_EOS; data->start_class->flags |= ANYOF_FOLD; if (OP(scan) == EXACTFL) @@ -877,7 +957,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (data->start_class->flags & ANYOF_FOLD) { /* false positive possible if the class is case-folded. Assume that the locale settings are the same... */ - ANYOF_BITMAP_SET(data->start_class, *STRING(scan)); + if (uc < 0x100) + ANYOF_BITMAP_SET(data->start_class, uc); data->start_class->flags &= ~ANYOF_EOS; } cl_and(data->start_class, &and_with); @@ -885,7 +966,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg flags &= ~SCF_DO_STCLASS; } else if (strchr((char*)PL_varies,OP(scan))) { - I32 mincount, maxcount, minnext, deltanext, fl; + I32 mincount, maxcount, minnext, deltanext, fl = 0; I32 f = flags, pos_before = 0; regnode *oscan = scan; struct regnode_charclass_class this_class; @@ -899,8 +980,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) { next = NEXTOPER(scan); if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) { - mincount = 1; - maxcount = REG_INFTY; + mincount = 1; + maxcount = REG_INFTY; next = regnext(scan); scan = NEXTOPER(scan); goto do_curly; @@ -913,12 +994,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg case STAR: if (flags & SCF_DO_STCLASS) { mincount = 0; - maxcount = REG_INFTY; + maxcount = REG_INFTY; next = regnext(scan); scan = NEXTOPER(scan); goto do_curly; } - is_inf = is_inf_internal = 1; + is_inf = is_inf_internal = 1; scan = regnext(scan); if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state, data); /* Cannot extend fixed substrings */ @@ -926,7 +1007,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } goto optimize_curly_tail; case CURLY: - mincount = ARG1(scan); + mincount = ARG1(scan); maxcount = ARG2(scan); next = regnext(scan); if (OP(scan) == CURLYX) { @@ -956,15 +1037,15 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg /* These are the cases when once a subexpression fails at a particular position, it cannot succeed even after backtracking at the enclosing scope. - + XXXX what if minimal match and we are at the initial run of {n,m}? */ if ((mincount != maxcount - 1) && (maxcount != REG_INFTY)) f &= ~SCF_WHILEM_VISITED_POS; /* This will finish on WHILEM, setting scan, or on NULL: */ - minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data, - mincount == 0 + minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data, + mincount == 0 ? (f & ~SCF_DO_SUBSTR) : f); if (flags & SCF_DO_STCLASS) @@ -974,7 +1055,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg cl_or(pRExC_state, data->start_class, &this_class); } else if (flags & SCF_DO_STCLASS_AND) { - /* Switch to OR mode: cache the old value of + /* Switch to OR mode: cache the old value of * data->start_class */ StructCopy(data->start_class, &and_with, struct regnode_charclass_class); @@ -995,8 +1076,9 @@ 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) && (minnext + deltanext == 0) - && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)) + if (ckWARN(WARN_REGEXP) + && (minnext == 0) && (deltanext == 0) + && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)) && maxcount <= REG_INFTY/3) /* Complement check for big count */ { vWARN(RExC_parse, @@ -1004,14 +1086,14 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } min += minnext * mincount; - is_inf_internal |= ((maxcount == REG_INFTY + is_inf_internal |= ((maxcount == REG_INFTY && (minnext + deltanext) > 0) || deltanext == I32_MAX); is_inf |= is_inf_internal; delta += (minnext + deltanext) * maxcount - minnext * mincount; /* Try powerful optimization CURLYX => CURLYN. */ - if ( OP(oscan) == CURLYX && data + if ( OP(oscan) == CURLYX && data && data->flags & SF_IN_PAR && !(data->flags & SF_HAS_EVAL) && !deltanext && minnext == 1 ) { @@ -1023,11 +1105,11 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg nxt = regnext(nxt); if (!strchr((char*)PL_simple,OP(nxt)) && !(PL_regkind[(U8)OP(nxt)] == EXACT - && STR_LEN(nxt) == 1)) + && STR_LEN(nxt) == 1)) goto nogo; nxt2 = nxt; nxt = regnext(nxt); - if (OP(nxt) != CLOSE) + if (OP(nxt) != CLOSE) goto nogo; /* Now we know that nxt2 is the only contents: */ oscan->flags = ARG(nxt); @@ -1040,12 +1122,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg OP(nxt) = OPTIMIZED; /* was CLOSE. */ OP(nxt + 1) = OPTIMIZED; /* was count. */ NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */ -#endif +#endif } nogo: /* Try optimization CURLYX => CURLYM. */ - if ( OP(oscan) == CURLYX && data + if ( OP(oscan) == CURLYX && data && !(data->flags & SF_HAS_PAR) && !(data->flags & SF_HAS_EVAL) && !deltanext ) { @@ -1056,7 +1138,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg OP(oscan) = CURLYM; while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/ - && (OP(nxt2) != WHILEM)) + && (OP(nxt2) != WHILEM)) nxt = nxt2; OP(nxt2) = SUCCEED; /* Whas WHILEM */ /* Need to optimize away parenths. */ @@ -1064,7 +1146,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg /* Set the parenth number. */ regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/ - if (OP(nxt) != CLOSE) + if (OP(nxt) != CLOSE) FAIL("Panic opt close"); oscan->flags = ARG(nxt); OP(nxt1) = OPTIMIZED; /* was OPEN. */ @@ -1074,11 +1156,11 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg OP(nxt + 1) = OPTIMIZED; /* was count. */ NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */ NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */ -#endif +#endif #if 0 while ( nxt1 && (OP(nxt1) != WHILEM)) { regnode *nnxt = regnext(nxt1); - + if (nnxt == nxt) { if (reg_off_by_arg[OP(nxt1)]) ARG_SET(nxt1, nxt2 - nxt1); @@ -1091,7 +1173,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } #endif /* Optimize again: */ - study_chunk(pRExC_state, &nxt1, &deltanext, nxt, + study_chunk(pRExC_state, &nxt1, &deltanext, nxt, NULL, 0); } else @@ -1113,14 +1195,14 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg PREVOPER(nxt)->flags = data->whilem_c | (RExC_whilem_seen << 4); /* On WHILEM */ } - if (data && fl & (SF_HAS_PAR|SF_IN_PAR)) + if (data && fl & (SF_HAS_PAR|SF_IN_PAR)) pars++; if (flags & SCF_DO_SUBSTR) { SV *last_str = Nullsv; int counted = mincount != 0; if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */ - I32 b = pos_before >= data->last_start_min + I32 b = pos_before >= data->last_start_min ? pos_before : data->last_start_min; STRLEN l; char *s = SvPV(data->last_found, l); @@ -1136,11 +1218,11 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg /* What was added is a constant string */ if (mincount > 1) { SvGROW(last_str, (mincount * l) + 1); - repeatcpy(SvPVX(last_str) + l, + repeatcpy(SvPVX(last_str) + l, SvPVX(last_str), l, mincount - 1); SvCUR(last_str) *= mincount; /* Add additional parts. */ - SvCUR_set(data->last_found, + SvCUR_set(data->last_found, SvCUR(data->last_found) - l); sv_catsv(data->last_found, last_str); data->last_end += l * (mincount - 1); @@ -1163,10 +1245,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (mincount && last_str) { sv_setsv(data->last_found, last_str); data->last_end = data->pos_min; - data->last_start_min = + data->last_start_min = data->pos_min - CHR_SVLEN(last_str); - data->last_start_max = is_inf - ? I32_MAX + data->last_start_max = is_inf + ? I32_MAX : data->pos_min + data->pos_delta - CHR_SVLEN(last_str); } @@ -1196,7 +1278,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } } else if (strchr((char*)PL_simple,OP(scan))) { - int value; + int value = 0; if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state,data); @@ -1250,7 +1332,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg else { for (value = 0; value < 256; value++) if (isALNUM(value)) - ANYOF_BITMAP_SET(data->start_class, value); + ANYOF_BITMAP_SET(data->start_class, value); } } break; @@ -1279,7 +1361,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg else { for (value = 0; value < 256; value++) if (!isALNUM(value)) - ANYOF_BITMAP_SET(data->start_class, value); + ANYOF_BITMAP_SET(data->start_class, value); } } break; @@ -1308,7 +1390,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg else { for (value = 0; value < 256; value++) if (isSPACE(value)) - ANYOF_BITMAP_SET(data->start_class, value); + ANYOF_BITMAP_SET(data->start_class, value); } } break; @@ -1337,7 +1419,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg else { for (value = 0; value < 256; value++) if (!isSPACE(value)) - ANYOF_BITMAP_SET(data->start_class, value); + ANYOF_BITMAP_SET(data->start_class, value); } } break; @@ -1368,7 +1450,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg else { for (value = 0; value < 256; value++) if (isDIGIT(value)) - ANYOF_BITMAP_SET(data->start_class, value); + ANYOF_BITMAP_SET(data->start_class, value); } } break; @@ -1385,7 +1467,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg else { for (value = 0; value < 256; value++) if (!isDIGIT(value)) - ANYOF_BITMAP_SET(data->start_class, value); + ANYOF_BITMAP_SET(data->start_class, value); } } break; @@ -1411,7 +1493,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg int f = 0; data_fake.flags = 0; - if (data) { + if (data) { data_fake.whilem_c = data->whilem_c; data_fake.last_closep = data->last_closep; } @@ -1485,7 +1567,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg finish: *scanp = scan; *deltap = is_inf_internal ? I32_MAX : delta; - if (flags & SCF_DO_SUBSTR && is_inf) + if (flags & SCF_DO_SUBSTR && is_inf) data->pos_delta = I32_MAX - data->pos_min; if (is_par > U8_MAX) is_par = 0; @@ -1506,8 +1588,8 @@ STATIC I32 S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, char *s) { if (RExC_rx->data) { - Renewc(RExC_rx->data, - sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1), + Renewc(RExC_rx->data, + sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1), char, struct reg_data); Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8); RExC_rx->data->count += n; @@ -1527,7 +1609,7 @@ Perl_reginitcolors(pTHX) { int i = 0; char *s = PerlEnv_getenv("PERL_RE_COLORS"); - + if (s) { PL_colors[0] = s = savepv(s); while (++i < 6) { @@ -1540,7 +1622,7 @@ Perl_reginitcolors(pTHX) PL_colors[i] = s = ""; } } else { - while (i < 6) + while (i < 6) PL_colors[i++] = ""; } PL_colorset = 1; @@ -1580,13 +1662,12 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) FAIL("NULL regexp argument"); /* XXXX This looks very suspicious... */ - if (pm->op_pmdynflags & PMdf_UTF8) { - PL_reg_flags |= RF_utf8; - } + if (pm->op_pmdynflags & PMdf_CMP_UTF8) + RExC_utf8 = 1; else - PL_reg_flags = 0; + RExC_utf8 = 0; - RExC_precomp = savepvn(exp, xend - exp); + RExC_precomp = exp; DEBUG_r(if (!PL_colorset) reginitcolors()); DEBUG_r(PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n", PL_colors[4],PL_colors[5],PL_colors[0], @@ -1601,6 +1682,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) /* First pass: determine size, legality. */ RExC_parse = exp; + RExC_start = exp; RExC_end = xend; RExC_naughty = 0; RExC_npar = 1; @@ -1612,7 +1694,6 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) REGC((U8)REG_MAGIC, (char*)RExC_emit); #endif if (reg(pRExC_state, 0, &flags) == NULL) { - Safefree(RExC_precomp); RExC_precomp = Nullch; return(NULL); } @@ -1639,7 +1720,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) #endif r->refcnt = 1; r->prelen = xend - exp; - r->precomp = RExC_precomp; + r->precomp = savepvn(RExC_precomp, r->prelen); r->subbeg = NULL; r->reganch = pm->op_pmflags & PMf_COMPILETIME; r->nparens = RExC_npar - 1; /* set early to validate backrefs */ @@ -1648,6 +1729,15 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->startp = 0; /* Useful during FAIL. */ r->endp = 0; /* Useful during FAIL. */ + Newz(1304, r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */ + if (r->offsets) { + r->offsets[0] = RExC_size; + } + DEBUG_r(PerlIO_printf(Perl_debug_log, + "%s %"UVuf" bytes for offset annotations.\n", + r->offsets ? "Got" : "Couldn't get", + (UV)((2*RExC_size+1) * sizeof(U32)))); + RExC_rx = r; /* Second pass: emit code. */ @@ -1655,6 +1745,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) RExC_end = xend; RExC_naughty = 0; RExC_npar = 1; + RExC_emit_start = r->program; RExC_emit = r->program; /* Store the count of eval-groups for security checks: */ RExC_emit->next_off = ((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals); @@ -1705,9 +1796,9 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) /* Starting-point info. */ again: if (PL_regkind[(U8)OP(first)] == EXACT) { - if (OP(first) == EXACT); /* Empty, get anchored substr later. */ - else if ((OP(first) == EXACTF || OP(first) == EXACTFL) - && !UTF) + if (OP(first) == EXACT) + ; /* Empty, get anchored substr later. */ + else if ((OP(first) == EXACTF || OP(first) == EXACTFL)) r->regstclass = first; } else if (strchr((char*)PL_simple,OP(first))) @@ -1745,13 +1836,13 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) first = NEXTOPER(first); goto again; } - if (sawplus && (!sawopen || !RExC_sawback) + if (sawplus && (!sawopen || !RExC_sawback) && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */ /* x+ must match at the 1st pos of run of x's */ r->reganch |= ROPT_SKIP; /* Scan is after the zeroth branch, first is atomic matcher. */ - DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n", + DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n", (IV)(first - scan + 1))); /* * If there's something expensive in the r.e., find the @@ -1782,7 +1873,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */ &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag); if ( RExC_npar == 1 && data.longest == &(data.longest_fixed) - && data.last_start_min == 0 && data.last_end > 0 + && data.last_start_min == 0 && data.last_end > 0 && !RExC_seen_zerolen && (!(RExC_seen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS))) r->reganch |= ROPT_CHECK_ALL; @@ -1835,16 +1926,15 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) SvREFCNT_dec(data.longest_fixed); longest_fixed_length = 0; } - if (r->regstclass + if (r->regstclass && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == SANY)) r->regstclass = NULL; if ((!r->anchored_substr || r->anchored_offset) && stclass_flag && !(data.start_class->flags & ANYOF_EOS) && !cl_is_anything(data.start_class)) { - SV *sv; I32 n = add_data(pRExC_state, 1, "f"); - New(1006, RExC_rx->data->data[n], 1, + New(1006, RExC_rx->data->data[n], 1, struct regnode_charclass_class); StructCopy(data.start_class, (struct regnode_charclass_class*)RExC_rx->data->data[n], @@ -1852,10 +1942,11 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->regstclass = (regnode*)RExC_rx->data->data[n]; r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */ PL_regdata = r->data; /* for regprop() */ - DEBUG_r((sv = sv_newmortal(), - regprop(sv, (regnode*)data.start_class), - PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n", - SvPVX(sv)))); + DEBUG_r({ SV *sv = sv_newmortal(); + regprop(sv, (regnode*)data.start_class); + PerlIO_printf(Perl_debug_log, + "synthetic stclass `%s'.\n", + SvPVX(sv));}); } /* A temporary algorithm prefers floated substr to fixed one to dig more info. */ @@ -1893,30 +1984,32 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->check_substr = r->anchored_substr = r->float_substr = Nullsv; if (!(data.start_class->flags & ANYOF_EOS) && !cl_is_anything(data.start_class)) { - SV *sv; I32 n = add_data(pRExC_state, 1, "f"); - New(1006, RExC_rx->data->data[n], 1, + New(1006, RExC_rx->data->data[n], 1, struct regnode_charclass_class); StructCopy(data.start_class, (struct regnode_charclass_class*)RExC_rx->data->data[n], struct regnode_charclass_class); r->regstclass = (regnode*)RExC_rx->data->data[n]; r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */ - DEBUG_r((sv = sv_newmortal(), - regprop(sv, (regnode*)data.start_class), - PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n", - SvPVX(sv)))); + DEBUG_r({ SV* sv = sv_newmortal(); + regprop(sv, (regnode*)data.start_class); + PerlIO_printf(Perl_debug_log, + "synthetic stclass `%s'.\n", + SvPVX(sv));}); } } r->minlen = minlen; - if (RExC_seen & REG_SEEN_GPOS) + if (RExC_seen & REG_SEEN_GPOS) r->reganch |= ROPT_GPOS_SEEN; if (RExC_seen & REG_SEEN_LOOKBEHIND) r->reganch |= ROPT_LOOKBEHIND_SEEN; if (RExC_seen & REG_SEEN_EVAL) r->reganch |= ROPT_EVAL_SEEN; + if (RExC_seen & REG_SEEN_SANY) + r->reganch |= ROPT_SANY_SEEN; Newz(1002, r->startp, RExC_npar, I32); Newz(1002, r->endp, RExC_npar, I32); PL_regdata = r->data; /* for regprop() */ @@ -1943,14 +2036,26 @@ 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 == '?') { + if (*RExC_parse == '?') { /* (?...) */ U16 posflags = 0, negflags = 0; U16 *flagsp = &posflags; int logical = 0; @@ -1960,24 +2065,24 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) paren = *RExC_parse++; ret = NULL; /* For look-ahead/behind. */ switch (paren) { - case '<': + case '<': /* (?<...) */ RExC_seen |= REG_SEEN_LOOKBEHIND; - if (*RExC_parse == '!') + if (*RExC_parse == '!') paren = ','; - if (*RExC_parse != '=' && *RExC_parse != '!') + if (*RExC_parse != '=' && *RExC_parse != '!') goto unknown; RExC_parse++; - case '=': - case '!': + case '=': /* (?=...) */ + case '!': /* (?!...) */ RExC_seen_zerolen++; - case ':': - case '>': + case ':': /* (?:...) */ + case '>': /* (?>...) */ break; - case '$': - case '@': + case '$': /* (?$...) */ + case '@': /* (?@...) */ vFAIL2("Sequence (?%c...) not implemented", (int)paren); break; - case '#': + case '#': /* (?#...) */ while (*RExC_parse && *RExC_parse != ')') RExC_parse++; if (*RExC_parse != ')') @@ -1985,15 +2090,15 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) nextchar(pRExC_state); *flagp = TRYAGAIN; return NULL; - case 'p': - if (SIZE_ONLY) - vWARN(RExC_parse, "(?p{}) is deprecated - use (??{})"); + case 'p': /* (?p...) */ + if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP)) + vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})"); /* FALL THROUGH*/ - case '?': + case '?': /* (??...) */ logical = 1; paren = *RExC_parse++; /* FALL THROUGH */ - case '{': + case '{': /* (?{...}) */ { I32 count = 1, n = 0; char c; @@ -2006,21 +2111,21 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) while (count && (c = *RExC_parse)) { if (c == '\\' && RExC_parse[1]) RExC_parse++; - else if (c == '{') + else if (c == '{') count++; - else if (c == '}') + else if (c == '}') count--; RExC_parse++; } if (*RExC_parse != ')') { - RExC_parse = s; + RExC_parse = s; vFAIL("Sequence (?{...}) not terminated or not {}-balanced"); } if (!SIZE_ONLY) { AV *av; - - if (RExC_parse - 1 - s) + + if (RExC_parse - 1 - s) sv = newSVpvn(s, RExC_parse - 1 - s); else sv = newSVpvn("", 0); @@ -2042,7 +2147,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) /* No compiled RE interpolated, has runtime components ===> unsafe. */ FAIL("Eval-group not allowed at runtime, use re 'eval'"); - if (PL_tainted) + if (PL_tainting && PL_tainted) FAIL("Eval-group in insecure regular expression"); } @@ -2052,15 +2157,16 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) if (!SIZE_ONLY) ret->flags = 2; regtail(pRExC_state, ret, reganode(pRExC_state, EVAL, n)); + /* deal with the length of this later - MJD */ return ret; } return reganode(pRExC_state, EVAL, n); } - case '(': + case '(': /* (?(?{...})...) and (?(?=...)...) */ { - if (RExC_parse[0] == '?') { - if (RExC_parse[1] == '=' || RExC_parse[1] == '!' - || RExC_parse[1] == '<' + if (RExC_parse[0] == '?') { /* (?(?...)) */ + if (RExC_parse[1] == '=' || RExC_parse[1] == '!' + || RExC_parse[1] == '<' || RExC_parse[1] == '{') { /* Lookahead or eval. */ I32 flag; @@ -2069,14 +2175,16 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) ret->flags = 1; regtail(pRExC_state, ret, reg(pRExC_state, 1, &flag)); goto insert_if; - } + } } else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) { + /* (?(1)...) */ parno = atoi(RExC_parse++); while (isDIGIT(*RExC_parse)) RExC_parse++; - ret = reganode(pRExC_state, GROUPP, parno); + ret = reganode(pRExC_state, GROUPP, parno); + if ((c = *nextchar(pRExC_state)) != ')') vFAIL("Switch condition not recognized"); insert_if: @@ -2121,14 +2229,47 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) break; default: --RExC_parse; - parse_flags: + 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; } @@ -2149,26 +2290,34 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) return NULL; } } - else { + else { /* (...) */ parno = RExC_npar; RExC_npar++; ret = reganode(pRExC_state, OPEN, parno); + Set_Node_Length(ret, 1); /* MJD */ + Set_Node_Offset(ret, RExC_parse); /* MJD */ open = 1; } } - else + else /* ! paren */ ret = NULL; /* Pick up the branches, linking them together. */ + parse_start = RExC_parse; /* MJD */ br = regbranch(pRExC_state, &flags, 1); + /* branch_len = (paren != 0); */ + if (br == NULL) return(NULL); if (*RExC_parse == '|') { if (!SIZE_ONLY && RExC_extralen) { reginsert(pRExC_state, BRANCHJ, br); } - else + else { /* MJD */ reginsert(pRExC_state, BRANCH, br); + Set_Node_Length(br, paren != 0); + Set_Node_Offset_To_R(br-RExC_emit_start, parse_start-RExC_start); + } have_branch = 1; if (SIZE_ONLY) RExC_extralen += 1; /* For BRANCHJ-BRANCH. */ @@ -2194,6 +2343,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) RExC_extralen += 2; /* Account for LONGJMP. */ nextchar(pRExC_state); br = regbranch(pRExC_state, &flags, 0); + if (br == NULL) return(NULL); regtail(pRExC_state, lastbr, br); /* BRANCH -> BRANCH. */ @@ -2211,6 +2361,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) break; case 1: ender = reganode(pRExC_state, CLOSE, parno); + Set_Node_Offset(ender,RExC_parse+1); /* MJD */ + Set_Node_Length(ender,1); /* MJD */ break; case '<': case ',': @@ -2285,18 +2437,20 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first) register regnode *latest; I32 flags = 0, c = 0; - if (first) + if (first) ret = NULL; else { - if (!SIZE_ONLY && RExC_extralen) + if (!SIZE_ONLY && RExC_extralen) ret = reganode(pRExC_state, BRANCHJ,0); - else + else { ret = reg_node(pRExC_state, BRANCH); + Set_Node_Length(ret, 1); + } } - if (!first && SIZE_ONLY) + if (!first && SIZE_ONLY) RExC_extralen += 1; /* BRANCHJ */ - + *flagp = WORST; /* Tentatively. */ RExC_parse--; @@ -2353,6 +2507,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) char *maxpos; I32 min; I32 max = REG_INFTY; + char *parse_start; ret = regatom(pRExC_state, &flags); if (ret == NULL) { @@ -2364,6 +2519,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) op = *RExC_parse; if (op == '{' && regcurly(RExC_parse)) { + parse_start = RExC_parse; /* MJD */ next = RExC_parse + 1; maxpos = Nullch; while (isDIGIT(*next) || *next == ',') { @@ -2396,6 +2552,8 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) if ((flags&SIMPLE)) { RExC_naughty += 2 + RExC_naughty / 2; reginsert(pRExC_state, CURLY, ret); + Set_Node_Offset(ret, parse_start+1); /* MJD */ + Set_Node_Cur_Length(ret); } else { regnode *w = reg_node(pRExC_state, WHILEM); @@ -2408,6 +2566,11 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) NEXT_OFF(ret) = 3; /* Go over LONGJMP. */ } reginsert(pRExC_state, CURLYX,ret); + /* MJD hk */ + Set_Node_Offset(ret, parse_start+1); + Set_Node_Length(ret, + op == '{' ? (RExC_parse - parse_start) : 1); + if (!SIZE_ONLY && RExC_extralen) NEXT_OFF(ret) = 3; /* Go over NOTHING to LONGJMP. */ regtail(pRExC_state, ret, reg_node(pRExC_state, NOTHING)); @@ -2451,8 +2614,9 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) if (!(flags&HASWIDTH) && op != '?') vFAIL("Regexp *+ operand could be empty"); -#endif +#endif + parse_start = RExC_parse; nextchar(pRExC_state); *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH); @@ -2528,10 +2692,11 @@ tryagain: ret = reg_node(pRExC_state, SBOL); else ret = reg_node(pRExC_state, BOL); + Set_Node_Length(ret, 1); /* MJD */ break; case '$': nextchar(pRExC_state); - if (*RExC_parse) + if (*RExC_parse) RExC_seen_zerolen++; if (RExC_flags16 & PMf_MULTILINE) ret = reg_node(pRExC_state, MEOL); @@ -2539,6 +2704,7 @@ tryagain: ret = reg_node(pRExC_state, SEOL); else ret = reg_node(pRExC_state, EOL); + Set_Node_Length(ret, 1); /* MJD */ break; case '.': nextchar(pRExC_state); @@ -2548,6 +2714,7 @@ tryagain: ret = reg_node(pRExC_state, REG_ANY); *flagp |= HASWIDTH|SIMPLE; RExC_naughty++; + Set_Node_Length(ret, 1); /* MJD */ break; case '[': { @@ -2559,6 +2726,7 @@ tryagain: } nextchar(pRExC_state); *flagp |= HASWIDTH|SIMPLE; + Set_Node_Length(ret, RExC_parse - oregcomp_parse + 1); /* MJD */ break; } case '(': @@ -2605,12 +2773,14 @@ tryagain: ret = reg_node(pRExC_state, SBOL); *flagp |= SIMPLE; nextchar(pRExC_state); + Set_Node_Length(ret, 2); /* MJD */ break; case 'G': ret = reg_node(pRExC_state, GPOS); RExC_seen |= REG_SEEN_GPOS; *flagp |= SIMPLE; nextchar(pRExC_state); + Set_Node_Length(ret, 2); /* MJD */ break; case 'Z': ret = reg_node(pRExC_state, SEOL); @@ -2622,32 +2792,32 @@ tryagain: *flagp |= SIMPLE; RExC_seen_zerolen++; /* Do not optimize RE away */ nextchar(pRExC_state); + Set_Node_Length(ret, 2); /* MJD */ break; case 'C': ret = reg_node(pRExC_state, SANY); + RExC_seen |= REG_SEEN_SANY; *flagp |= HASWIDTH|SIMPLE; nextchar(pRExC_state); + Set_Node_Length(ret, 2); /* MJD */ break; case 'X': ret = reg_node(pRExC_state, CLUMP); *flagp |= HASWIDTH; nextchar(pRExC_state); - if (UTF && !PL_utf8_mark) - is_utf8_mark((U8*)"~"); /* preload table */ + Set_Node_Length(ret, 2); /* MJD */ break; case 'w': ret = reg_node(pRExC_state, LOC ? ALNUML : ALNUM); *flagp |= HASWIDTH|SIMPLE; nextchar(pRExC_state); - if (UTF && !PL_utf8_alnum) - is_utf8_alnum((U8*)"a"); /* preload table */ + Set_Node_Length(ret, 2); /* MJD */ break; case 'W': ret = reg_node(pRExC_state, LOC ? NALNUML : NALNUM); *flagp |= HASWIDTH|SIMPLE; nextchar(pRExC_state); - if (UTF && !PL_utf8_alnum) - is_utf8_alnum((U8*)"a"); /* preload table */ + Set_Node_Length(ret, 2); /* MJD */ break; case 'b': RExC_seen_zerolen++; @@ -2655,8 +2825,7 @@ tryagain: ret = reg_node(pRExC_state, LOC ? BOUNDL : BOUND); *flagp |= SIMPLE; nextchar(pRExC_state); - if (UTF && !PL_utf8_alnum) - is_utf8_alnum((U8*)"a"); /* preload table */ + Set_Node_Length(ret, 2); /* MJD */ break; case 'B': RExC_seen_zerolen++; @@ -2664,43 +2833,40 @@ tryagain: ret = reg_node(pRExC_state, LOC ? NBOUNDL : NBOUND); *flagp |= SIMPLE; nextchar(pRExC_state); - if (UTF && !PL_utf8_alnum) - is_utf8_alnum((U8*)"a"); /* preload table */ + Set_Node_Length(ret, 2); /* MJD */ break; case 's': ret = reg_node(pRExC_state, LOC ? SPACEL : SPACE); *flagp |= HASWIDTH|SIMPLE; nextchar(pRExC_state); - if (UTF && !PL_utf8_space) - is_utf8_space((U8*)" "); /* preload table */ + Set_Node_Length(ret, 2); /* MJD */ break; case 'S': ret = reg_node(pRExC_state, LOC ? NSPACEL : NSPACE); *flagp |= HASWIDTH|SIMPLE; nextchar(pRExC_state); - if (UTF && !PL_utf8_space) - is_utf8_space((U8*)" "); /* preload table */ + Set_Node_Length(ret, 2); /* MJD */ break; case 'd': ret = reg_node(pRExC_state, DIGIT); *flagp |= HASWIDTH|SIMPLE; nextchar(pRExC_state); - if (UTF && !PL_utf8_digit) - is_utf8_digit((U8*)"1"); /* preload table */ + Set_Node_Length(ret, 2); /* MJD */ break; case 'D': ret = reg_node(pRExC_state, NDIGIT); *flagp |= HASWIDTH|SIMPLE; nextchar(pRExC_state); - if (UTF && !PL_utf8_digit) - is_utf8_digit((U8*)"1"); /* preload table */ + Set_Node_Length(ret, 2); /* MJD */ break; case 'p': case 'P': - { /* a lovely hack--pretend we saw [\pX] instead */ + { char* oldregxend = RExC_end; + char* parse_start = RExC_parse; if (RExC_parse[1] == '{') { + /* a lovely hack--pretend we saw [\pX] instead */ RExC_end = strchr(RExC_parse, '}'); if (!RExC_end) { RExC_parse += 2; @@ -2717,6 +2883,7 @@ tryagain: RExC_end = oldregxend; RExC_parse--; + Set_Node_Cur_Length(ret); /* MJD */ nextchar(pRExC_state); *flagp |= HASWIDTH|SIMPLE; } @@ -2739,6 +2906,7 @@ tryagain: if (num > 9 && num >= RExC_npar) goto defchar; else { + char * parse_start = RExC_parse - 1; /* MJD */ while (isDIGIT(*RExC_parse)) RExC_parse++; @@ -2749,6 +2917,10 @@ tryagain: ? (LOC ? REFFL : REFF) : REF, num); *flagp |= HASWIDTH; + + /* override incorrect value set in reganode MJD */ + Set_Node_Offset(ret, parse_start+1); + Set_Node_Cur_Length(ret); /* MJD */ RExC_parse--; nextchar(pRExC_state); } @@ -2779,6 +2951,7 @@ tryagain: register char *p; char *oldp, *s; STRLEN numlen; + char *parse_start = RExC_parse - 1; RExC_parse++; @@ -2839,25 +3012,17 @@ tryagain: p++; break; case 'e': -#ifdef ASCIIish - ender = '\033'; -#else - ender = '\047'; -#endif + ender = ASCII_TO_NATIVE('\033'); p++; break; case 'a': -#ifdef ASCIIish - ender = '\007'; -#else - ender = '\057'; -#endif + ender = ASCII_TO_NATIVE('\007'); p++; break; case 'x': if (*++p == '{') { char* e = strchr(p, '}'); - + if (!e) { RExC_parse = p + 1; vFAIL("Missing right brace on \\x{}"); @@ -2865,6 +3030,8 @@ tryagain: else { numlen = 1; /* allow underscores */ ender = (UV)scan_hex(p + 1, e - p - 1, &numlen); + if (ender > 0xff) + RExC_utf8 = 1; /* numlen is generous */ if (numlen + len >= 127) { p--; @@ -2909,8 +3076,8 @@ tryagain: break; default: normal_default: - if ((*p & 0xc0) == 0xc0 && UTF) { - ender = utf8_to_uv((U8*)p, RExC_end - p, + if (UTF8_IS_START(*p) && UTF) { + ender = utf8n_to_uvchr((U8*)p, RExC_end - p, &numlen, 0); p += numlen; } @@ -2922,14 +3089,14 @@ tryagain: p = regwhite(p, RExC_end); if (UTF && FOLD) { if (LOC) - ender = toLOWER_LC_uni(ender); + ender = toLOWER_LC_uvchr(ender); else ender = toLOWER_uni(ender); } if (ISMULT2(p)) { /* Back off on ?+*. */ if (len) p = oldp; - else if (ender >= 0x80 && UTF) { + else if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(ender)) && UTF) { reguni(pRExC_state, ender, s, &numlen); s += numlen; len += numlen; @@ -2940,7 +3107,7 @@ tryagain: } break; } - if (ender >= 0x80 && UTF) { + if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(ender)) && UTF) { reguni(pRExC_state, ender, s, &numlen); s += numlen; len += numlen - 1; @@ -2950,6 +3117,7 @@ tryagain: } loopdone: RExC_parse = p - 1; + Set_Node_Cur_Length(ret); /* MJD */ nextchar(pRExC_state); { /* len is STRLEN which is unsigned, need to copy to signed */ @@ -3009,7 +3177,7 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) *RExC_parse == '.')) { char c = *RExC_parse; char* s = RExC_parse++; - + while (RExC_parse < RExC_end && *RExC_parse != c) RExC_parse++; if (RExC_parse == RExC_end) @@ -3154,16 +3322,17 @@ STATIC regnode * S_regclass(pTHX_ RExC_state_t *pRExC_state) { register UV value; - register IV lastvalue = OOB_UNICODE; + register IV prevvalue = OOB_UNICODE; register IV range = 0; register regnode *ret; STRLEN numlen; IV namedclass; - char *rangebegin; + char *rangebegin = 0; bool need_class = 0; - SV *listsv; + SV *listsv = Nullsv; register char *e; UV n; + bool optimize_invert = TRUE; ret = reganode(pRExC_state, ANYOF, 0); @@ -3204,9 +3373,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) if (!range) rangebegin = RExC_parse; if (UTF) { - value = utf8_to_uv((U8*)RExC_parse, - RExC_end - RExC_parse, - &numlen, 0); + value = utf8n_to_uvchr((U8*)RExC_parse, + RExC_end - RExC_parse, + &numlen, 0); RExC_parse += numlen; } else @@ -3215,7 +3384,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) namedclass = regpposixcc(pRExC_state, value); else if (value == '\\') { if (UTF) { - value = utf8_to_uv((U8*)RExC_parse, + value = utf8n_to_uvchr((U8*)RExC_parse, RExC_end - RExC_parse, &numlen, 0); RExC_parse += numlen; @@ -3262,17 +3431,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) case 't': value = '\t'; break; case 'f': value = '\f'; break; case 'b': value = '\b'; break; -#ifdef ASCIIish - case 'e': value = '\033'; break; - case 'a': value = '\007'; break; -#else - case 'e': value = '\047'; break; - case 'a': value = '\057'; break; -#endif + case 'e': value = ASCII_TO_NATIVE('\033');break; + case 'a': value = ASCII_TO_NATIVE('\007');break; case 'x': if (*RExC_parse == '{') { e = strchr(RExC_parse++, '}'); - if (!e) + if (!e) vFAIL("Missing right brace on \\x{}"); numlen = 1; /* allow underscores */ value = (UV)scan_hex(RExC_parse, @@ -3321,15 +3485,14 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) RExC_parse - rangebegin, RExC_parse - rangebegin, rangebegin); - if (lastvalue < 256) { - ANYOF_BITMAP_SET(ret, lastvalue); + if (prevvalue < 256) { + ANYOF_BITMAP_SET(ret, prevvalue); ANYOF_BITMAP_SET(ret, '-'); } else { ANYOF_FLAGS(ret) |= ANYOF_UNICODE; Perl_sv_catpvf(aTHX_ listsv, - /* 0x002D is Unicode for '-' */ - "%04"UVxf"\n002D\n", (UV)lastvalue); + "%04"UVxf"\n%04"UVxf"\n", (UV)prevvalue, (UV) '-'); } } @@ -3337,6 +3500,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) } if (!SIZE_ONLY) { + if (namedclass > OOB_NAMEDCLASS) + optimize_invert = FALSE; /* Possible truncation here but in some 64-bit environments * the compiler gets heartburn about switch on 64-bit values. * A similar issue a little earlier when switching on value. @@ -3406,13 +3571,14 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) if (LOC) ANYOF_CLASS_SET(ret, ANYOF_ASCII); else { -#ifdef ASCIIish +#ifndef EBCDIC for (value = 0; value < 128; value++) ANYOF_BITMAP_SET(ret, value); #else /* EBCDIC */ - for (value = 0; value < 256; value++) + for (value = 0; value < 256; value++) { if (isASCII(value)) - ANYOF_BITMAP_SET(ret, value); + ANYOF_BITMAP_SET(ret, value); + } #endif /* EBCDIC */ } Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsASCII\n"); @@ -3421,13 +3587,14 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) if (LOC) ANYOF_CLASS_SET(ret, ANYOF_NASCII); else { -#ifdef ASCIIish +#ifndef EBCDIC for (value = 128; value < 256; value++) ANYOF_BITMAP_SET(ret, value); #else /* EBCDIC */ - for (value = 0; value < 256; value++) + for (value = 0; value < 256; value++) { if (!isASCII(value)) - ANYOF_BITMAP_SET(ret, value); + ANYOF_BITMAP_SET(ret, value); + } #endif /* EBCDIC */ } Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsASCII\n"); @@ -3665,16 +3832,16 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) } /* end of namedclass \blah */ if (range) { - if (lastvalue > value) /* b-a */ { + if (prevvalue > value) /* b-a */ { Simple_vFAIL4("Invalid [] range \"%*.*s\"", RExC_parse - rangebegin, RExC_parse - rangebegin, rangebegin); + range = 0; /* not a valid range */ } - range = 0; /* not a true range */ } else { - lastvalue = value; /* save the beginning of the range */ + prevvalue = value; /* save the beginning of the range */ if (*RExC_parse == '-' && RExC_parse+1 < RExC_end && RExC_parse[1] != ']') { RExC_parse++; @@ -3697,32 +3864,36 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) /* now is the next time */ if (!SIZE_ONLY) { - if (lastvalue < 256 && value < 256) { -#ifndef ASCIIish /* EBCDIC, for example. */ - if ((isLOWER(lastvalue) && isLOWER(value)) || - (isUPPER(lastvalue) && isUPPER(value))) + IV i; + + if (prevvalue < 256) { + IV ceilvalue = value < 256 ? value : 255; + +#ifdef EBCDIC + if ((isLOWER(prevvalue) && isLOWER(ceilvalue)) || + (isUPPER(prevvalue) && isUPPER(ceilvalue))) { - IV i; - if (isLOWER(lastvalue)) { - for (i = lastvalue; i <= value; i++) + if (isLOWER(prevvalue)) { + for (i = prevvalue; i <= ceilvalue; i++) if (isLOWER(i)) ANYOF_BITMAP_SET(ret, i); } else { - for (i = lastvalue; i <= value; i++) + for (i = prevvalue; i <= ceilvalue; i++) if (isUPPER(i)) ANYOF_BITMAP_SET(ret, i); } } else #endif - for ( ; lastvalue <= value; lastvalue++) - ANYOF_BITMAP_SET(ret, lastvalue); - } else { + for (i = prevvalue; i <= ceilvalue; i++) + ANYOF_BITMAP_SET(ret, i); + } + if (value > 255) { ANYOF_FLAGS(ret) |= ANYOF_UNICODE; - if (lastvalue < value) + if (prevvalue < value) Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n", - (UV)lastvalue, (UV)value); - else + (UV)prevvalue, (UV)value); + else if (prevvalue == value) Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n", (UV)value); } @@ -3732,6 +3903,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) } if (need_class) { + ANYOF_FLAGS(ret) |= ANYOF_LARGE; if (SIZE_ONLY) RExC_size += ANYOF_CLASS_ADD_SKIP; else @@ -3740,9 +3912,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */ if (!SIZE_ONLY && - (ANYOF_FLAGS(ret) & /* If the only flag is folding (plus possibly inversion). */ - (ANYOF_FLAGS_ALL ^ ANYOF_INVERT) == ANYOF_FOLD)) { + ((ANYOF_FLAGS(ret) & (ANYOF_FLAGS_ALL ^ ANYOF_INVERT)) == ANYOF_FOLD) + ) { for (value = 0; value < 256; ++value) { if (ANYOF_BITMAP_TEST(ret, value)) { IV fold = PL_fold[value]; @@ -3755,15 +3927,15 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) } /* optimize inverted simple patterns (e.g. [^a-z]) */ - if (!SIZE_ONLY && + if (!SIZE_ONLY && optimize_invert && /* If the only flag is inversion. */ (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) { for (value = 0; value < ANYOF_BITMAP_SIZE; ++value) ANYOF_BITMAP(ret)[value] ^= ANYOF_FLAGS_ALL; - ANYOF_FLAGS(ret) = 0; + ANYOF_FLAGS(ret) = ANYOF_UNICODE_ALL; } - if (!SIZE_ONLY) { + if (!SIZE_ONLY) { AV *av = newAV(); SV *rv; @@ -3826,6 +3998,18 @@ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) NODE_ALIGN_FILL(ret); ptr = ret; FILL_ADVANCE_NODE(ptr, op); + if (RExC_offsets) { /* MJD */ + MJD_OFFSET_DEBUG((stderr, "%s:%u: (op %s) %s %u <- %u (len %u) (max %u).\n", + "reg_node", __LINE__, + reg_name[op], + RExC_emit - RExC_emit_start > RExC_offsets[0] + ? "Overwriting end of array!\n" : "OK", + RExC_emit - RExC_emit_start, + RExC_parse - RExC_start, + RExC_offsets[0])); + Set_Node_Offset(RExC_emit, RExC_parse + (op == END)); + } + RExC_emit = ptr; return(ret); @@ -3850,6 +4034,17 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) NODE_ALIGN_FILL(ret); ptr = ret; FILL_ADVANCE_NODE_ARG(ptr, op, arg); + if (RExC_offsets) { /* MJD */ + MJD_OFFSET_DEBUG((stderr, "%s: %s %u <- %u (max %u).\n", + "reganode", + RExC_emit - RExC_emit_start > RExC_offsets[0] ? + "Overwriting end of array!\n" : "OK", + RExC_emit - RExC_emit_start, + RExC_parse - RExC_start, + RExC_offsets[0])); + Set_Cur_Node_Offset; + } + RExC_emit = ptr; return(ret); @@ -3861,7 +4056,7 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) STATIC void S_reguni(pTHX_ RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) { - *lenp = SIZE_ONLY ? UNISKIP(uv) : (uv_to_utf8((U8*)s, uv) - (U8*)s); + *lenp = SIZE_ONLY ? UNISKIP(uv) : (uvchr_to_utf8((U8*)s, uv) - (U8*)s); } /* @@ -3876,7 +4071,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd) register regnode *dst; register regnode *place; register int offset = regarglen[(U8)op]; - + /* (PL_regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */ if (SIZE_ONLY) { @@ -3887,10 +4082,33 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd) src = RExC_emit; RExC_emit += NODE_STEP_REGNODE + offset; dst = RExC_emit; - while (src > opnd) + while (src > opnd) { StructCopy(--src, --dst, regnode); + if (RExC_offsets) { /* MJD 20010112 */ + MJD_OFFSET_DEBUG((stderr, "%s: %s copy %u -> %u (max %u).\n", + "reg_insert", + dst - RExC_emit_start > RExC_offsets[0] + ? "Overwriting end of array!\n" : "OK", + src - RExC_emit_start, + dst - RExC_emit_start, + RExC_offsets[0])); + Set_Node_Offset_To_R(dst-RExC_emit_start, Node_Offset(src)); + Set_Node_Length_To_R(dst-RExC_emit_start, Node_Length(src)); + } + } + place = opnd; /* Op node, where operand used to be. */ + if (RExC_offsets) { /* MJD */ + MJD_OFFSET_DEBUG((stderr, "%s: %s %u <- %u (max %u).\n", + "reginsert", + place - RExC_emit_start > RExC_offsets[0] + ? "Overwriting end of array!\n" : "OK", + place - RExC_emit_start, + RExC_parse - RExC_start, + RExC_offsets[0])); + Set_Node_Offset(place, RExC_parse); + } src = NEXTOPER(place); FILL_ADVANCE_NODE(place, op); Zero(src, offset, regnode); @@ -3966,10 +4184,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; @@ -3989,13 +4208,13 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) (int)(2*l + 1), "", SvPVX(sv)); if (next == NULL) /* Next ptr. */ PerlIO_printf(Perl_debug_log, "(0)"); - else + else PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start)); (void)PerlIO_putc(Perl_debug_log, '\n'); after_print: if (PL_regkind[(U8)op] == BRANCHJ) { - register regnode *nnode = (OP(next) == LONGJMP - ? regnext(next) + register regnode *nnode = (OP(next) == LONGJMP + ? regnext(next) : next); if (last && nnode > last) nnode = last; @@ -4016,8 +4235,10 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1); } else if (op == ANYOF) { + /* arglen 1 + class block */ + node += 1 + ((ANYOF_FLAGS(node) & ANYOF_LARGE) + ? ANYOF_CLASS_SKIP : ANYOF_SKIP); node = NEXTOPER(node); - node += ANYOF_SKIP; } else if (PL_regkind[(U8)op] == EXACT) { /* Literal string, where present. */ @@ -4033,10 +4254,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 */ @@ -4051,25 +4273,25 @@ Perl_regdump(pTHX_ regexp *r) /* Header fields of interest. */ if (r->anchored_substr) PerlIO_printf(Perl_debug_log, - "anchored `%s%.*s%s'%s at %"IVdf" ", + "anchored `%s%.*s%s'%s at %"IVdf" ", PL_colors[0], (int)(SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0)), - SvPVX(r->anchored_substr), + SvPVX(r->anchored_substr), PL_colors[1], SvTAIL(r->anchored_substr) ? "$" : "", (IV)r->anchored_offset); if (r->float_substr) PerlIO_printf(Perl_debug_log, - "floating `%s%.*s%s'%s at %"IVdf"..%"UVuf" ", + "floating `%s%.*s%s'%s at %"IVdf"..%"UVuf" ", PL_colors[0], - (int)(SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0)), + (int)(SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0)), SvPVX(r->float_substr), PL_colors[1], SvTAIL(r->float_substr) ? "$" : "", (IV)r->float_min_offset, (UV)r->float_max_offset); if (r->check_substr) - PerlIO_printf(Perl_debug_log, - r->check_substr == r->float_substr + PerlIO_printf(Perl_debug_log, + r->check_substr == r->float_substr ? "(checking floating" : "(checking anchored"); if (r->reganch & ROPT_NOSCAN) PerlIO_printf(Perl_debug_log, " noscan"); @@ -4104,9 +4326,21 @@ Perl_regdump(pTHX_ regexp *r) if (r->reganch & ROPT_EVAL_SEEN) PerlIO_printf(Perl_debug_log, "with eval "); PerlIO_printf(Perl_debug_log, "\n"); + if (r->offsets) { + U32 i; + U32 len = r->offsets[0]; + PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]); + for (i = 1; i <= len; i++) + PerlIO_printf(Perl_debug_log, "%"UVuf"[%"UVuf"] ", + (UV)r->offsets[i*2-1], + (UV)r->offsets[i*2]); + PerlIO_printf(Perl_debug_log, "\n"); + } #endif /* DEBUGGING */ } +#ifdef DEBUGGING + STATIC void S_put_byte(pTHX_ SV *sv, int c) { @@ -4118,6 +4352,8 @@ S_put_byte(pTHX_ SV *sv, int c) Perl_sv_catpvf(aTHX_ sv, "%c", c); } +#endif /* DEBUGGING */ + /* - regprop - printable representation of opcode */ @@ -4218,35 +4454,37 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) if (flags & ANYOF_UNICODE) sv_catpv(sv, "{unicode}"); + else if (flags & ANYOF_UNICODE_ALL) + sv_catpv(sv, "{all-unicode}"); { SV *lv; SV *sw = regclass_swash(o, FALSE, &lv); - + if (lv) { if (sw) { UV i; U8 s[UTF8_MAXLEN+1]; - + for (i = 0; i <= 256; i++) { /* just the first 256 */ - U8 *e = uv_to_utf8(s, i); + U8 *e = uvchr_to_utf8(s, i); - if (i < 256 && swash_fetch(sw, s)) { + if (i < 256 && swash_fetch(sw, s, TRUE)) { if (rangestart == -1) rangestart = i; } else if (rangestart != -1) { U8 *p; - + if (i <= rangestart + 3) for (; rangestart < i; rangestart++) { - for(e = uv_to_utf8(s, rangestart), p = s; p < e; p++) + for(e = uvchr_to_utf8(s, rangestart), p = s; p < e; p++) put_byte(sv, *p); } else { - for (e = uv_to_utf8(s, rangestart), p = s; p < e; p++) + for (e = uvchr_to_utf8(s, rangestart), p = s; p < e; p++) put_byte(sv, *p); sv_catpv(sv, "-"); - for (e = uv_to_utf8(s, i - 1), p = s; p < e; p++) + for (e = uvchr_to_utf8(s, i - 1), p = s; p < e; p++) put_byte(sv, *p); } rangestart = -1; @@ -4259,9 +4497,9 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) { char *s = savepv(SvPVX(lv)); char *origs = s; - + while(*s && *s != '\n') s++; - + if (*s == '\n') { char *t = ++s; @@ -4275,7 +4513,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) sv_catpv(sv, t); } - + Safefree(origs); } } @@ -4323,6 +4561,8 @@ Perl_pregfree(pTHX_ struct regexp *r) if (r->precomp) Safefree(r->precomp); + if (r->offsets) /* 20010421 MJD */ + Safefree(r->offsets); if (RX_MATCH_COPIED(r)) Safefree(r->subbeg); if (r->substrs) { @@ -4440,7 +4680,7 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...) void Perl_save_re_context(pTHX) -{ +{ #if 0 SAVEPPTR(RExC_precomp); /* uncompiled string. */ SAVEI32(RExC_npar); /* () count. */ @@ -4464,10 +4704,8 @@ Perl_save_re_context(pTHX) SAVEVPTR(PL_regendp); /* Ditto for endp. */ SAVEVPTR(PL_reglastparen); /* Similarly for lastparen. */ SAVEPPTR(PL_regtill); /* How far we are required to go. */ - SAVEI8(PL_regprev); /* char before regbol, \n if none */ - SAVEVPTR(PL_reg_start_tmp); /* from regexec.c */ + SAVEGENERICPV(PL_reg_start_tmp); /* from regexec.c */ PL_reg_start_tmp = 0; - SAVEFREEPV(PL_reg_start_tmp); SAVEI32(PL_reg_start_tmpl); /* from regexec.c */ PL_reg_start_tmpl = 0; SAVEVPTR(PL_regdata); @@ -4486,8 +4724,9 @@ Perl_save_re_context(pTHX) SAVEVPTR(PL_reg_oldcurpm); /* from regexec.c */ SAVEVPTR(PL_reg_curpm); /* from regexec.c */ SAVEI32(PL_regnpar); /* () count. */ + SAVEI32(PL_regsize); /* from regexec.c */ #ifdef DEBUGGING - SAVEPPTR(PL_reg_starttry); /* from regexec.c */ + SAVEPPTR(PL_reg_starttry); /* from regexec.c */ #endif } @@ -4502,3 +4741,4 @@ clear_re(pTHXo_ void *r) { ReREFCNT_dec((regexp *)r); } +