#define OOB_CHAR8 1234
#define OOB_UTF8 123456
+#define OOB_NAMEDCLASS -1
#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
#define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
FAIL("variable length lookbehind not implemented");
}
else if (minnext > U8_MAX) {
-#ifdef UV_IS_QUAD
- FAIL2("lookbehind longer than %" PERL_PRIu64 " not implemented", (UV)U8_MAX);
-#else
- FAIL2("lookbehind longer than %d not implemented", U8_MAX);
-#endif
+ FAIL2("lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
}
scan->flags = minnext;
}
r->check_offset_min = data.offset_float_min;
r->check_offset_max = data.offset_float_max;
}
- if (r->check_substr) {
+ /* XXXX Currently intuiting is not compatible with ANCH_GPOS.
+ This should be changed ASAP! */
+ if (r->check_substr && !(r->reganch & ROPT_ANCH_GPOS)) {
r->reganch |= RE_USE_INTUIT;
if (SvTAIL(r->check_substr))
r->reganch |= RE_INTUIT_TAIL;
}
break;
}
- if ((namedclass == -1 ||
+ if ((namedclass == OOB_NAMEDCLASS ||
!(posixcc + skip + 2 < PL_regxend &&
(posixcc[skip] == ':' &&
posixcc[skip + 1] == ']'))))
*PL_regcomp_parse == '=' ||
*PL_regcomp_parse == '.')) {
char *s = PL_regcomp_parse;
- char c = *s++;
+ char c = *s++;
while(*s && isALNUM(*s))
s++;
goto skipcond; /* allow 1st char to be ] or - */
while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != ']') {
skipcond:
- namedclass = -1;
+ namedclass = OOB_NAMEDCLASS;
value = UCHARAT(PL_regcomp_parse++);
if (value == '[')
namedclass = regpposixcc(value);
break;
}
}
- if (!SIZE_ONLY && namedclass > -1) {
+ if (!SIZE_ONLY && namedclass > OOB_NAMEDCLASS) {
+ if (range)
+ FAIL("invalid [] range in regexp"); /* [a-\w], [a-[:word:]] */
switch (namedclass) {
case ANYOF_ALNUM:
if (LOC)
}
if (LOC)
ANYOF_FLAGS(opnd) |= ANYOF_CLASS;
- lastvalue = OOB_CHAR8;
+ continue;
}
- else
if (range) {
if (lastvalue > value)
- FAIL("invalid [] range in regexp");
+ FAIL("invalid [] range in regexp"); /* [b-a] */
range = 0;
}
else {
lastvalue = value;
if (*PL_regcomp_parse == '-' && PL_regcomp_parse+1 < PL_regxend &&
- PL_regcomp_parse[1] != ']') {
+ PL_regcomp_parse[1] != ']') {
+ if (namedclass > OOB_NAMEDCLASS)
+ FAIL("invalid [] range in regexp"); /* [\w-a] */
PL_regcomp_parse++;
range = 1;
continue; /* do it next time */
}
}
+ /* now is the next time */
if (!SIZE_ONLY) {
-#ifndef ASCIIish
+#ifndef ASCIIish /* EBCDIC, for example. */
if ((isLOWER(lastvalue) && isLOWER(value)) ||
(isUPPER(lastvalue) && isUPPER(value)))
{
for ( ; lastvalue <= value; lastvalue++)
ANYOF_BITMAP_SET(opnd, lastvalue);
}
- lastvalue = value;
+ range = 0;
}
/* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
if (!SIZE_ONLY &&
while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != ']') {
skipcond:
- namedclass = -1;
+ namedclass = OOB_NAMEDCLASS;
value = utf8_to_uv((U8*)PL_regcomp_parse, &numlen);
PL_regcomp_parse += numlen;
break;
}
}
- if (!SIZE_ONLY && namedclass > -1) {
+ if (!SIZE_ONLY && namedclass > OOB_NAMEDCLASS) {
+ if (range)
+ FAIL("invalid [] range in regexp"); /* [a-\w], [a-[:word:]] */
switch (namedclass) {
case ANYOF_ALNUM:
Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsWord\n"); break;
case ANYOF_NXDIGIT:
Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsXDigit\n"); break;
}
+ continue;
}
- else
if (range) {
if (lastvalue > value)
- FAIL("invalid [] range in regexp");
-#ifdef UV_IS_QUAD
- if (!SIZE_ONLY)
- Perl_sv_catpvf(aTHX_ listsv, "%04" PERL_PRIx64 "\t%04" PERL_PRIx64 "\n", (UV)lastvalue, (UV)value);
-#else
+ FAIL("invalid [] range in regexp"); /* [b-a] */
if (!SIZE_ONLY)
- Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\n", lastvalue, value);
-#endif
- lastvalue = value;
+ Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n", (UV)lastvalue, (UV)value);
range = 0;
}
else {
lastvalue = value;
if (*PL_regcomp_parse == '-' && PL_regcomp_parse+1 < PL_regxend &&
- PL_regcomp_parse[1] != ']') {
+ PL_regcomp_parse[1] != ']') {
+ if (namedclass > OOB_NAMEDCLASS)
+ FAIL("invalid [] range in regexp"); /* [\w-a] */
PL_regcomp_parse++;
range = 1;
continue; /* do it next time */
}
-#ifdef UV_IS_QUAD
- if (!SIZE_ONLY)
- Perl_sv_catpvf(aTHX_ listsv, "%04" PERL_PRIx64 "\n", (UV)value);
-#else
- if (!SIZE_ONLY)
- Perl_sv_catpvf(aTHX_ listsv, "%04x\n", value);
-#endif
}
+ /* now is the next time */
+ if (!SIZE_ONLY)
+ Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n", (UV)value);
+ range = 0;
}
ret = reganode(ANYOFUTF8, 0);
k = PL_regkind[(U8)OP(o)];
if (k == EXACT)
- Perl_sv_catpvf(aTHX_ sv, " <%s%*s%s>", PL_colors[0],
+ Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>", PL_colors[0],
STR_LEN(o), STRING(o), PL_colors[1]);
else if (k == CURLY) {
if (OP(o) == CURLYM || OP(o) == CURLYN)
else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP )
Perl_sv_catpvf(aTHX_ sv, "%d", ARG(o)); /* Parenth number */
else if (k == LOGICAL)
- Perl_sv_catpvf(aTHX_ sv, "[%d]", ARG(o)); /* 2: embedded, otherwise 1 */
+ Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */
else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH))
Perl_sv_catpvf(aTHX_ sv, "[-%d]", o->flags);
#endif /* DEBUGGING */
{
dTHR;
DEBUG_r(if (!PL_colorset) reginitcolors());
+
+ if (!r || (--r->refcnt > 0))
+ return;
DEBUG_r(PerlIO_printf(Perl_debug_log,
"%sFreeing REx:%s `%s%.60s%s%s'\n",
PL_colors[4],PL_colors[5],PL_colors[0],
PL_colors[1],
(strlen(r->precomp) > 60 ? "..." : "")));
-
- if (!r || (--r->refcnt > 0))
- return;
if (r->precomp)
Safefree(r->precomp);
if (RX_MATCH_COPIED(r))
#else
va_start(args);
#endif
- msv = mess(buf, &args);
+ msv = vmess(buf, &args);
va_end(args);
message = SvPV(msv,l1);
if (l1 > 512)