have unique chars.
We use an array of integers to represent the character codes 0..255
- (trie->charmap) and we use a an HV* to store unicode characters. We use the
+ (trie->charmap) and we use a an HV* to store Unicode characters. We use the
native representation of the character value as the key and IV's for the
coded index.
/* store the codepoint in the bitmap, and if its ascii
also store its folded equivelent. */
TRIE_BITMAP_SET(trie,uvc);
- if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
+
+ /* store the folded codepoint */
+ if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
+
+ if ( !UTF ) {
+ /* store first byte of utf8 representation of
+ codepoints in the 127 < uvc < 256 range */
+ if (127 < uvc && uvc < 192) {
+ TRIE_BITMAP_SET(trie,194);
+ } else if (191 < uvc ) {
+ TRIE_BITMAP_SET(trie,195);
+ /* && uvc < 256 -- we know uvc is < 256 already */
+ }
+ }
set_bit = 0; /* We've done our bit :-) */
}
} else {
}
if ( count == 1 ) {
SV **tmp = av_fetch( revcharmap, idx, 0);
- char *ch = SvPV_nolen( *tmp );
+ STRLEN len;
+ char *ch = SvPV( *tmp, len );
DEBUG_OPTIMISE_r({
SV *sv=sv_newmortal();
PerlIO_printf( Perl_debug_log,
str=STRING(convert);
STR_LEN(convert)=0;
}
- while (*ch) {
+ STR_LEN(convert) += len;
+ while (len--)
*str++ = *ch++;
- STR_LEN(convert)++;
- }
-
} else {
#ifdef DEBUGGING
if (state>1)
SvUTF8(sv) && SvMAGICAL(sv) ?
mg_find(sv, PERL_MAGIC_utf8) : NULL;
if (mg && mg->mg_len >= 0)
- mg->mg_len += CHR_SVLEN(last_str);
+ mg->mg_len += CHR_SVLEN(last_str) - l;
}
data->last_end += l * (mincount - 1);
}
char* exp = SvPV((SV*)pattern, plen);
char* xend = exp + plen;
regnode *scan;
- regnode *first;
I32 flags;
I32 minlen = 0;
I32 sawplus = 0;
return(NULL);
}
if (RExC_utf8 && !RExC_orig_utf8) {
- /* It's possible to write a regexp in ascii that represents unicode
+ /* It's possible to write a regexp in ascii that represents Unicode
codepoints outside of the byte range, such as via \x{100}. If we
detect such a sequence we have to convert the entire pattern to utf8
and then recompile, as our sizing calculation will have been based
r->prelen = plen;
r->extflags = pm_flags;
{
- bool has_k = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
+ bool has_p = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
bool has_minus = ((r->extflags & RXf_PMf_STD_PMMOD) != RXf_PMf_STD_PMMOD);
bool has_runon = ((RExC_seen & REG_SEEN_RUN_ON_COMMENT)==REG_SEEN_RUN_ON_COMMENT);
U16 reganch = (U16)((r->extflags & RXf_PMf_STD_PMMOD) >> 12);
const char *fptr = STD_PAT_MODS; /*"msix"*/
char *p;
- r->wraplen = r->prelen + has_minus + has_k + has_runon
+ r->wraplen = r->prelen + has_minus + has_p + has_runon
+ (sizeof(STD_PAT_MODS) - 1)
+ (sizeof("(?:)") - 1);
Newx(r->wrapped, r->wraplen + 1, char );
p = r->wrapped;
*p++='('; *p++='?';
- if (has_k)
- *p++ = KEEPCOPY_PAT_MOD; /*'k'*/
+ if (has_p)
+ *p++ = KEEPCOPY_PAT_MOD; /*'p'*/
{
char *r = p + (sizeof(STD_PAT_MODS) - 1) + has_minus - 1;
char *colon = r + 1;
/* Store the count of eval-groups for security checks: */
RExC_rx->seen_evals = RExC_seen_evals;
REGC((U8)REG_MAGIC, (char*) RExC_emit++);
- if (reg(pRExC_state, 0, &flags,1) == NULL)
+ if (reg(pRExC_state, 0, &flags,1) == NULL) {
+ ReREFCNT_dec(r);
return(NULL);
-
+ }
/* XXXX To minimize changes to RE engine we always allocate
3-units-long substrs field. */
Newx(r->substrs, 1, struct reg_substr_data);
#endif
/* Dig out information for optimizations. */
- r->extflags = pm_flags; /* Again? */
+ r->extflags = RExC_flags; /* was pm_op */
/*dmq: removed as part of de-PMOP: pm->op_pmflags = RExC_flags; */
if (UTF)
struct regnode_charclass_class ch_class; /* pointed to by data */
int stclass_flag;
I32 last_close = 0; /* pointed to by data */
-
- first = scan;
+ regnode *first= scan;
+ regnode *first_next= regnext(first);
+
/* Skip introductions and multiplicators >= 1. */
while ((OP(first) == OPEN && (sawopen = 1)) ||
/* An OR of *one* alternative - should not happen now. */
- (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
+ (OP(first) == BRANCH && OP(first_next) != BRANCH) ||
/* for now we can't handle lookbehind IFMATCH*/
(OP(first) == IFMATCH && !first->flags) ||
(OP(first) == PLUS) ||
(OP(first) == MINMOD) ||
/* An {n,m} with n>0 */
- (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) )
+ (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) ||
+ (OP(first) == NOTHING && PL_regkind[OP(first_next)] != END ))
{
if (OP(first) == PLUS)
first += EXTRA_STEP_2ARGS;
} else /* XXX possible optimisation for /(?=)/ */
first = NEXTOPER(first);
+ first_next= regnext(first);
}
/* Starting-point info. */
r->paren_names = (HV*)SvREFCNT_inc(RExC_paren_names);
else
r->paren_names = NULL;
- if (r->prelen == 3 && strnEQ("\\s+", r->precomp, 3)) /* precomp = "\\s+)" */
- r->extflags |= RXf_WHITE;
+
+#ifdef STUPID_PATTERN_CHECKS
+ if (r->prelen == 0)
+ r->extflags |= RXf_NULL;
+ if (r->extflags & RXf_SPLIT && r->prelen == 1 && r->precomp[0] == ' ')
+ /* XXX: this should happen BEFORE we compile */
+ r->extflags |= (RXf_SKIPWHITE|RXf_WHITE);
+ else if (r->prelen == 3 && memEQ("\\s+", r->precomp, 3))
+ r->extflags |= RXf_WHITE;
else if (r->prelen == 1 && r->precomp[0] == '^')
r->extflags |= RXf_START_ONLY;
-
+#else
+ if (r->extflags & RXf_SPLIT && r->prelen == 1 && r->precomp[0] == ' ')
+ /* XXX: this should happen BEFORE we compile */
+ r->extflags |= (RXf_SKIPWHITE|RXf_WHITE);
+ else {
+ regnode *first = ri->program + 1;
+ U8 fop = OP(first);
+ U8 nop = OP(NEXTOPER(first));
+
+ if (PL_regkind[fop] == NOTHING && nop == END)
+ r->extflags |= RXf_NULL;
+ else if (PL_regkind[fop] == BOL && nop == END)
+ r->extflags |= RXf_START_ONLY;
+ else if (fop == PLUS && nop ==SPACE && OP(regnext(first))==END)
+ r->extflags |= RXf_WHITE;
+ }
+#endif
#ifdef DEBUGGING
if (RExC_paren_names) {
ri->name_list_idx = add_data( pRExC_state, 1, "p" );
SV*
-Perl_reg_named_buff_get(pTHX_ REGEXP * const rx, SV * const namesv, const U32 flags)
+Perl_reg_named_buff(pTHX_ REGEXP * const rx, SV * const key, SV * const value,
+ const U32 flags)
+{
+ PERL_UNUSED_ARG(value);
+
+ if (flags & RXapif_FETCH) {
+ return reg_named_buff_fetch(rx, key, flags);
+ } else if (flags & (RXapif_STORE | RXapif_DELETE | RXapif_CLEAR)) {
+ Perl_croak(aTHX_ PL_no_modify);
+ return NULL;
+ } else if (flags & RXapif_EXISTS) {
+ return reg_named_buff_exists(rx, key, flags)
+ ? &PL_sv_yes
+ : &PL_sv_no;
+ } else if (flags & RXapif_REGNAMES) {
+ return reg_named_buff_all(rx, flags);
+ } else if (flags & (RXapif_SCALAR | RXapif_REGNAMES_COUNT)) {
+ return reg_named_buff_scalar(rx, flags);
+ } else {
+ Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff", (int)flags);
+ return NULL;
+ }
+}
+
+SV*
+Perl_reg_named_buff_iter(pTHX_ REGEXP * const rx, const SV * const lastkey,
+ const U32 flags)
+{
+ PERL_UNUSED_ARG(lastkey);
+
+ if (flags & RXapif_FIRSTKEY)
+ return reg_named_buff_firstkey(rx, flags);
+ else if (flags & RXapif_NEXTKEY)
+ return reg_named_buff_nextkey(rx, flags);
+ else {
+ Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_iter", (int)flags);
+ return NULL;
+ }
+}
+
+SV*
+Perl_reg_named_buff_fetch(pTHX_ REGEXP * const rx, SV * const namesv, const U32 flags)
{
AV *retarray = NULL;
SV *ret;
- if (flags & 1)
+ if (flags & RXapif_ALL)
retarray=newAV();
if (rx && rx->paren_names) {
SV* sv_dat=HeVAL(he_str);
I32 *nums=(I32*)SvPVX(sv_dat);
for ( i=0; i<SvIVX(sv_dat); i++ ) {
- if ((I32)(rx->nparens) >= nums[i]
- && rx->offs[nums[i]].start != -1
- && rx->offs[nums[i]].end != -1)
+ if ((I32)(rx->nparens) >= nums[i]
+ && rx->offs[nums[i]].start != -1
+ && rx->offs[nums[i]].end != -1)
{
ret = newSVpvs("");
- CALLREG_NUMBUF(rx,nums[i],ret);
+ CALLREG_NUMBUF_FETCH(rx,nums[i],ret);
if (!retarray)
return ret;
} else {
}
}
if (retarray)
- return (SV*)retarray;
+ return newRV((SV*)retarray);
+ }
+ }
+ return NULL;
+}
+
+bool
+Perl_reg_named_buff_exists(pTHX_ REGEXP * const rx, SV * const key,
+ const U32 flags)
+{
+ if (rx && rx->paren_names) {
+ if (flags & RXapif_ALL) {
+ return hv_exists_ent(rx->paren_names, key, 0);
+ } else {
+ SV *sv = CALLREG_NAMED_BUFF_FETCH(rx, key, flags);
+ if (sv) {
+ SvREFCNT_dec(sv);
+ return TRUE;
+ } else {
+ return FALSE;
+ }
+ }
+ } else {
+ return FALSE;
+ }
+}
+
+SV*
+Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const rx, const U32 flags)
+{
+ (void)hv_iterinit(rx->paren_names);
+
+ return CALLREG_NAMED_BUFF_NEXTKEY(rx, NULL, flags & ~RXapif_FIRSTKEY);
+}
+
+SV*
+Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const rx, const U32 flags)
+{
+ if (rx && rx->paren_names) {
+ HV *hv = rx->paren_names;
+ HE *temphe;
+ while ( (temphe = hv_iternext_flags(hv,0)) ) {
+ IV i;
+ IV parno = 0;
+ SV* sv_dat = HeVAL(temphe);
+ I32 *nums = (I32*)SvPVX(sv_dat);
+ for ( i = 0; i < SvIVX(sv_dat); i++ ) {
+ if ((I32)(rx->lastcloseparen) >= nums[i] &&
+ rx->offs[nums[i]].start != -1 &&
+ rx->offs[nums[i]].end != -1)
+ {
+ parno = nums[i];
+ break;
+ }
+ }
+ if (parno || flags & RXapif_ALL) {
+ STRLEN len;
+ char *pv = HePV(temphe, len);
+ return newSVpvn(pv,len);
+ }
}
}
return NULL;
}
+SV*
+Perl_reg_named_buff_scalar(pTHX_ REGEXP * const rx, const U32 flags)
+{
+ SV *ret;
+ AV *av;
+ I32 length;
+
+ if (rx && rx->paren_names) {
+ if (flags & (RXapif_ALL | RXapif_REGNAMES_COUNT)) {
+ return newSViv(HvTOTALKEYS(rx->paren_names));
+ } else if (flags & RXapif_ONE) {
+ ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES));
+ av = (AV*)SvRV(ret);
+ length = av_len(av);
+ return newSViv(length + 1);
+ } else {
+ Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar", (int)flags);
+ return NULL;
+ }
+ }
+ return &PL_sv_undef;
+}
+
+SV*
+Perl_reg_named_buff_all(pTHX_ REGEXP * const rx, const U32 flags)
+{
+ AV *av = newAV();
+
+ if (rx && rx->paren_names) {
+ HV *hv= rx->paren_names;
+ HE *temphe;
+ (void)hv_iterinit(hv);
+ while ( (temphe = hv_iternext_flags(hv,0)) ) {
+ IV i;
+ IV parno = 0;
+ SV* sv_dat = HeVAL(temphe);
+ I32 *nums = (I32*)SvPVX(sv_dat);
+ for ( i = 0; i < SvIVX(sv_dat); i++ ) {
+ if ((I32)(rx->lastcloseparen) >= nums[i] &&
+ rx->offs[nums[i]].start != -1 &&
+ rx->offs[nums[i]].end != -1)
+ {
+ parno = nums[i];
+ break;
+ }
+ }
+ if (parno || flags & RXapif_ALL) {
+ STRLEN len;
+ char *pv = HePV(temphe, len);
+ av_push(av, newSVpvn(pv,len));
+ }
+ }
+ }
+
+ return newRV((SV*)av);
+}
+
void
-Perl_reg_numbered_buff_get(pTHX_ REGEXP * const rx, const I32 paren, SV * const sv)
+Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const rx, const I32 paren, SV * const sv)
{
char *s = NULL;
I32 i = 0;
return;
}
else
- if (paren == -2 && rx->offs[0].start != -1) {
+ if (paren == RX_BUFF_IDX_PREMATCH && rx->offs[0].start != -1) {
/* $` */
i = rx->offs[0].start;
s = rx->subbeg;
}
else
- if (paren == -1 && rx->offs[0].end != -1) {
+ if (paren == RX_BUFF_IDX_POSTMATCH && rx->offs[0].end != -1) {
/* $' */
s = rx->subbeg + rx->offs[0].end;
i = rx->sublen - rx->offs[0].end;
}
}
+void
+Perl_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren,
+ SV const * const value)
+{
+ PERL_UNUSED_ARG(rx);
+ PERL_UNUSED_ARG(paren);
+ PERL_UNUSED_ARG(value);
+
+ if (!PL_localizing)
+ Perl_croak(aTHX_ PL_no_modify);
+}
+
+I32
+Perl_reg_numbered_buff_length(pTHX_ REGEXP * const rx, const SV * const sv,
+ const I32 paren)
+{
+ I32 i;
+ I32 s1, t1;
+
+ /* Some of this code was originally in C<Perl_magic_len> in F<mg.c> */
+ switch (paren) {
+ /* $` / ${^PREMATCH} */
+ case RX_BUFF_IDX_PREMATCH:
+ if (rx->offs[0].start != -1) {
+ i = rx->offs[0].start;
+ if (i > 0) {
+ s1 = 0;
+ t1 = i;
+ goto getlen;
+ }
+ }
+ return 0;
+ /* $' / ${^POSTMATCH} */
+ case RX_BUFF_IDX_POSTMATCH:
+ if (rx->offs[0].end != -1) {
+ i = rx->sublen - rx->offs[0].end;
+ if (i > 0) {
+ s1 = rx->offs[0].end;
+ t1 = rx->sublen;
+ goto getlen;
+ }
+ }
+ return 0;
+ /* $& / ${^MATCH}, $1, $2, ... */
+ default:
+ if (paren <= (I32)rx->nparens &&
+ (s1 = rx->offs[paren].start) != -1 &&
+ (t1 = rx->offs[paren].end) != -1)
+ {
+ i = t1 - s1;
+ goto getlen;
+ } else {
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit((SV*)sv);
+ return 0;
+ }
+ }
+ getlen:
+ if (i > 0 && RX_MATCH_UTF8(rx)) {
+ const char * const s = rx->subbeg + s1;
+ const U8 *ep;
+ STRLEN el;
+
+ i = t1 - s1;
+ if (is_utf8_string_loclen((U8*)s, i, &ep, &el))
+ i = el;
+ }
+ return i;
+}
+
SV*
Perl_reg_qr_package(pTHX_ REGEXP * const rx)
{
register regnode *ender = NULL;
register I32 parno = 0;
I32 flags;
- const I32 oregflags = RExC_flags;
+ U32 oregflags = RExC_flags;
bool have_branch = 0;
bool is_open = 0;
I32 freeze_paren = 0;
and must be globally applied -- japhy */
switch (*RExC_parse) {
CASE_STD_PMMOD_FLAGS_PARSE_SET(flagsp);
- case 'o':
- case 'g':
+ case ONCE_PAT_MOD: /* 'o' */
+ case GLOBAL_PAT_MOD: /* 'g' */
if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
const I32 wflagbit = *RExC_parse == 'o' ? WASTED_O : WASTED_G;
if (! (wastedflags & wflagbit) ) {
}
break;
- case 'c':
+ case CONTINUE_PAT_MOD: /* 'c' */
if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
if (! (wastedflags & WASTED_C) ) {
wastedflags |= WASTED_GC;
}
}
break;
- case 'k':
+ case KEEPCOPY_PAT_MOD: /* 'p' */
if (flagsp == &negflags) {
if (SIZE_ONLY && ckWARN(WARN_REGEXP))
- vWARN(RExC_parse + 1,"Useless use of (?-k)");
+ vWARN(RExC_parse + 1,"Useless use of (?-p)");
} else {
*flagsp |= RXf_PMf_KEEPCOPY;
}
case ')':
RExC_flags |= posflags;
RExC_flags &= ~negflags;
+ if (paren != ':') {
+ oregflags |= posflags;
+ oregflags &= ~negflags;
+ }
nextchar(pRExC_state);
if (paren != ':') {
*flagp = TRYAGAIN;
/* RExC_parse points at the beginning brace,
endbrace points at the last */
if ( name[0]=='U' && name[1]=='+' ) {
- /* its a "unicode hex" notation {U+89AB} */
+ /* its a "Unicode hex" notation {U+89AB} */
I32 fl = PERL_SCAN_ALLOW_UNDERSCORES
| PERL_SCAN_DISALLOW_PREFIX
| (SIZE_ONLY ? PERL_SCAN_SILENT_ILLDIGIT : 0);
case 0xCE:
if (!LOC && FOLD) {
U32 len,cp;
+ len=0; /* silence a spurious compiler warning */
if ((cp = what_len_TRICKYFOLD_safe(RExC_parse,RExC_end,UTF,len))) {
*flagp |= HASWIDTH; /* could be SIMPLE too, but needs a handler in regexec.regrepeat */
RExC_parse+=len-1; /* we get one from nextchar() as well. :-( */
goto parse_named_seq;
} }
num = atoi(RExC_parse);
+ if (isg && num == 0)
+ vFAIL("Reference to invalid group 0");
if (isrel) {
num = RExC_npar - num;
if (num < 1)
case 'h': case 'H': /* HORIZWS */
case 'k': case 'K': /* named backref, keep marker */
case 'N': /* named char sequence */
- case 'p': case 'P': /* unicode property */
+ case 'p': case 'P': /* Unicode property */
case 'R': /* LNBREAK */
case 's': case 'S': /* space class */
case 'v': case 'V': /* VERTWS */
{
if (isLOWER(prevvalue)) {
for (i = prevvalue; i <= ceilvalue; i++)
- if (isLOWER(i))
+ if (isLOWER(i) && !ANYOF_BITMAP_TEST(ret,i)) {
+ stored++;
ANYOF_BITMAP_SET(ret, i);
+ }
} else {
for (i = prevvalue; i <= ceilvalue; i++)
- if (isUPPER(i))
+ if (isUPPER(i) && !ANYOF_BITMAP_TEST(ret,i)) {
+ stored++;
ANYOF_BITMAP_SET(ret, i);
+ }
}
}
else
/*
- regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
*/
+#ifdef DEBUGGING
+void
+S_regdump_extflags(pTHX_ const char *lead, const U32 flags) {
+ int bit;
+ int set=0;
+ for (bit=0; bit<32; bit++) {
+ if (flags & (1<<bit)) {
+ if (!set++ && lead)
+ PerlIO_printf(Perl_debug_log, "%s",lead);
+ PerlIO_printf(Perl_debug_log, "%s ",PL_reg_extflags_name[bit]);
+ }
+ }
+ if (lead) {
+ if (set)
+ PerlIO_printf(Perl_debug_log, "\n");
+ else
+ PerlIO_printf(Perl_debug_log, "%s[none-set]\n",lead);
+ }
+}
+#endif
+
void
Perl_regdump(pTHX_ const regexp *r)
{
SV * const sv = sv_newmortal();
SV *dsv= sv_newmortal();
RXi_GET_DECL(r,ri);
+ GET_RE_DEBUG_FLAGS_DECL;
(void)dumpuntil(r, ri->program, ri->program + 1, NULL, NULL, sv, 0, 0);
if (r->extflags & RXf_EVAL_SEEN)
PerlIO_printf(Perl_debug_log, "with eval ");
PerlIO_printf(Perl_debug_log, "\n");
+ DEBUG_FLAGS_r(regdump_extflags("r->extflags: ",r->extflags));
#else
PERL_UNUSED_CONTEXT;
PERL_UNUSED_ARG(r);
pv_pretty(dsv, STRING(o), STR_LEN(o), 60,
PL_colors[0], PL_colors[1],
PERL_PV_ESCAPE_UNI_DETECT |
- PERL_PV_PRETTY_ELIPSES |
+ PERL_PV_PRETTY_ELLIPSES |
PERL_PV_PRETTY_LTGT
);
Perl_sv_catpvf(aTHX_ sv, " %s", s );
} else if (k == LOGICAL)
Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */
else if (k == FOLDCHAR)
- Perl_sv_catpvf(aTHX_ sv, "[0x%"UVXf"]",ARG(o) );
+ Perl_sv_catpvf(aTHX_ sv, "[0x%"UVXf"]", PTR2UV(ARG(o)) );
else if (k == ANYOF) {
int i, rangestart = -1;
const U8 flags = ANYOF_FLAGS(o);
*/
void
-Perl_regfree_internal(pTHX_ struct regexp *r)
+Perl_regfree_internal(pTHX_ REGEXP * const r)
{
dVAR;
RXi_GET_DECL(r,ri);
elem_ptr ? pv_pretty(sv, SvPV_nolen_const(*elem_ptr), SvCUR(*elem_ptr), 60,
PL_colors[0], PL_colors[1],
(SvUTF8(*elem_ptr) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_PRETTY_ELIPSES |
+ PERL_PV_PRETTY_ELLIPSES |
PERL_PV_PRETTY_LTGT
)
: "???"
projects / p5sagit/p5-mst-13.2.git / blobdiff