X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/dd5def096b7b2dabfe2022669c29c16240d7da96..b5dffda6f343ffd74e5c9a395a43ef0450d6727b:/regcomp.c diff --git a/regcomp.c b/regcomp.c index 6ea593e..429b493 100644 --- a/regcomp.c +++ b/regcomp.c @@ -109,6 +109,7 @@ typedef struct RExC_state_t { char *parse; /* Input-scan pointer. */ I32 whilem_seen; /* number of WHILEM in this expr */ regnode *emit_start; /* Start of emitted-code area */ + regnode *emit_bound; /* First regnode outside of the allocated space */ regnode *emit; /* Code-emit pointer; ®dummy = don't = compiling */ I32 naughty; /* How bad is this pattern? */ I32 sawback; /* Did we see \1, ...? */ @@ -156,6 +157,7 @@ typedef struct RExC_state_t { #endif #define RExC_emit (pRExC_state->emit) #define RExC_emit_start (pRExC_state->emit_start) +#define RExC_emit_bound (pRExC_state->emit_bound) #define RExC_naughty (pRExC_state->naughty) #define RExC_sawback (pRExC_state->sawback) #define RExC_seen (pRExC_state->seen) @@ -4115,11 +4117,6 @@ Perl_re_compile(pTHX_ char *exp, char *xend, PMOP *pm) if (RExC_whilem_seen > 15) RExC_whilem_seen = 15; -#ifdef DEBUGGING - /* Make room for a sentinel value at the end of the program */ - RExC_size++; -#endif - /* Allocate space and zero-initialize. Note, the two step process of zeroing when in debug mode, thus anything assigned has to happen after that */ @@ -4215,11 +4212,8 @@ Perl_re_compile(pTHX_ char *exp, char *xend, PMOP *pm) RExC_npar = 1; RExC_emit_start = ri->program; RExC_emit = ri->program; -#ifdef DEBUGGING - /* put a sentinal on the end of the program so we can check for - overwrites */ - ri->program[RExC_size].type = 255; -#endif + RExC_emit_bound = ri->program + RExC_size + 1; + /* Store the count of eval-groups for security checks: */ RExC_rx->seen_evals = RExC_seen_evals; REGC((U8)REG_MAGIC, (char*) RExC_emit++); @@ -4710,8 +4704,9 @@ Perl_reg_named_buff_get(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags) SV* sv_dat=HeVAL(he_str); I32 *nums=(I32*)SvPVX(sv_dat); for ( i=0; ilastparen) >= nums[i] && - rx->endp[nums[i]] != -1) + if ((I32)(rx->nparens) >= nums[i] + && rx->startp[nums[i]] != -1 + && rx->endp[nums[i]] != -1) { ret = CALLREG_NUMBUF(rx,nums[i],NULL); if (!retarray) @@ -4884,7 +4879,7 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) { PerlIO_printf(Perl_debug_log,"%16s",""); \ \ if (SIZE_ONLY) \ - num=RExC_size; \ + num = RExC_size + 1; \ else \ num=REG_NODE_NUM(RExC_emit); \ if (RExC_lastnum!=num) \ @@ -5324,10 +5319,6 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) } /* named and numeric backreferences */ /* NOT REACHED */ - case 'p': /* (?p...) */ - if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP)) - vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})"); - /* FALL THROUGH*/ case '?': /* (??...) */ is_logical = 1; if (*RExC_parse != '{') { @@ -5518,6 +5509,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) } else REGTAIL(pRExC_state, ret, ender); + RExC_size++; /* XXX WHY do we need this?!! + For large programs it seems to be required + but I can't figure out why. -- dmq*/ return ret; } else { @@ -7746,7 +7740,7 @@ parseit: return ret; /****** !SIZE_ONLY AFTER HERE *********/ - if( stored == 1 && value < 256 + if( stored == 1 && (value < 128 || (value < 256 && !UTF)) && !( ANYOF_FLAGS(ret) & ( ANYOF_FLAGS_ALL ^ ANYOF_FOLD ) ) ) { /* optimize single char class to an EXACT node @@ -7896,11 +7890,9 @@ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) RExC_size += 1; return(ret); } -#ifdef DEBUGGING - if (OP(RExC_emit) == 255) - Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %s: %d ", - reg_name[op], OP(RExC_emit)); -#endif + if (RExC_emit >= RExC_emit_bound) + Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d", op); + NODE_ALIGN_FILL(ret); ptr = ret; FILL_ADVANCE_NODE(ptr, op); @@ -7908,7 +7900,7 @@ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) if (RExC_offsets) { /* MJD */ MJD_OFFSET_DEBUG(("%s:%d: (op %s) %s %"UVuf" (len %"UVuf") (max %"UVuf").\n", "reg_node", __LINE__, - reg_name[op], + PL_reg_name[op], (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ? "Overwriting end of array!\n" : "OK", (UV)(RExC_emit - RExC_emit_start), @@ -7951,10 +7943,9 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) */ return(ret); } -#ifdef DEBUGGING - if (OP(RExC_emit) == 255) - Perl_croak(aTHX_ "panic: reganode overwriting end of allocated program space"); -#endif + if (RExC_emit >= RExC_emit_bound) + Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d", op); + NODE_ALIGN_FILL(ret); ptr = ret; FILL_ADVANCE_NODE_ARG(ptr, op, arg); @@ -7963,7 +7954,7 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n", "reganode", __LINE__, - reg_name[op], + PL_reg_name[op], (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ? "Overwriting end of array!\n" : "OK", (UV)(RExC_emit - RExC_emit_start), @@ -8001,8 +7992,9 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd, U32 depth) const int offset = regarglen[(U8)op]; const int size = NODE_STEP_REGNODE + offset; GET_RE_DEBUG_FLAGS_DECL; + PERL_UNUSED_ARG(depth); /* (PL_regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */ - DEBUG_PARSE_FMT("inst"," - %s",reg_name[op]); + DEBUG_PARSE_FMT("inst"," - %s",PL_reg_name[op]); if (SIZE_ONLY) { RExC_size += size; return; @@ -8013,19 +8005,19 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd, U32 depth) dst = RExC_emit; if (RExC_open_parens) { int paren; - DEBUG_PARSE_FMT("inst"," - %"IVdf, (IV)RExC_npar); + /*DEBUG_PARSE_FMT("inst"," - %"IVdf, (IV)RExC_npar);*/ for ( paren=0 ; paren < RExC_npar ; paren++ ) { if ( RExC_open_parens[paren] >= opnd ) { - DEBUG_PARSE_FMT("open"," - %d",size); + /*DEBUG_PARSE_FMT("open"," - %d",size);*/ RExC_open_parens[paren] += size; } else { - DEBUG_PARSE_FMT("open"," - %s","ok"); + /*DEBUG_PARSE_FMT("open"," - %s","ok");*/ } if ( RExC_close_parens[paren] >= opnd ) { - DEBUG_PARSE_FMT("close"," - %d",size); + /*DEBUG_PARSE_FMT("close"," - %d",size);*/ RExC_close_parens[paren] += size; } else { - DEBUG_PARSE_FMT("close"," - %s","ok"); + /*DEBUG_PARSE_FMT("close"," - %s","ok");*/ } } } @@ -8037,7 +8029,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd, U32 depth) MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s copy %"UVuf" -> %"UVuf" (max %"UVuf").\n", "reg_insert", __LINE__, - reg_name[op], + PL_reg_name[op], (UV)(dst - RExC_emit_start) > RExC_offsets[0] ? "Overwriting end of array!\n" : "OK", (UV)(src - RExC_emit_start), @@ -8056,7 +8048,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd, U32 depth) MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n", "reginsert", __LINE__, - reg_name[op], + PL_reg_name[op], (UV)(place - RExC_emit_start) > RExC_offsets[0] ? "Overwriting end of array!\n" : "OK", (UV)(place - RExC_emit_start), @@ -8100,7 +8092,7 @@ S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 de PerlIO_printf(Perl_debug_log, "~ %s (%d) %s %s\n", SvPV_nolen_const(mysv), REG_NODE_NUM(scan), (temp == NULL ? "->" : ""), - (temp == NULL ? reg_name[OP(val)] : "") + (temp == NULL ? PL_reg_name[OP(val)] : "") ); }); if (temp == NULL) @@ -8181,7 +8173,7 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val, PerlIO_printf(Perl_debug_log, "~ %s (%d) -> %s\n", SvPV_nolen_const(mysv), REG_NODE_NUM(scan), - reg_name[exact]); + PL_reg_name[exact]); }); if (temp == NULL) break; @@ -8339,7 +8331,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) /* It would be nice to FAIL() here, but this may be called from regexec.c, and it would be hard to supply pRExC_state. */ Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", (int)OP(o), (int)REGNODE_MAX); - sv_catpv(sv, reg_name[OP(o)]); /* Take off const! */ + sv_catpv(sv, PL_reg_name[OP(o)]); /* Take off const! */ k = PL_regkind[OP(o)]; @@ -8368,7 +8360,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) const reg_trie_data * const trie = (reg_trie_data*)progi->data->data[!IS_TRIE_AC(op) ? n : ac->trie]; - Perl_sv_catpvf(aTHX_ sv, "-%s",reg_name[o->flags]); + Perl_sv_catpvf(aTHX_ sv, "-%s",PL_reg_name[o->flags]); DEBUG_TRIE_COMPILE_r( Perl_sv_catpvf(aTHX_ sv, "",