? reghop3((U8*)pos, off, \
(U8*)(off >= 0 ? reginfo->strend : reginfo->strbeg)) \
: (U8*)(pos + off))
+
#define HOPBACKc(pos, off) \
(char*)(reginfo->is_utf8_target \
? reghopmaybe3((U8*)pos, -off, (U8*)(reginfo->strbeg)) \
#define HOP3(pos,off,lim) (reginfo->is_utf8_target ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
#define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
+/* lim must be +ve. Returns NULL on overshoot */
+#define HOPMAYBE3(pos,off,lim) \
+ (reginfo->is_utf8_target \
+ ? reghopmaybe3((U8*)pos, off, (U8*)(lim)) \
+ : ((U8*)pos + off <= lim) \
+ ? (U8*)pos + off \
+ : NULL)
+
/* like HOP3, but limits the result to <= lim even for the non-utf8 case.
* off must be >=0; args should be vars rather than expressions */
#define HOP3lim(pos,off,lim) (reginfo->is_utf8_target \
#if 0
/* Currently these are only used when PL_regkind[OP(rn)] == EXACT so
- we don't need this definition. */
+ we don't need this definition. XXX These are now out-of-sync*/
#define IS_TEXT(rn) ( OP(rn)==EXACT || OP(rn)==REF || OP(rn)==NREF )
#define IS_TEXTF(rn) ( OP(rn)==EXACTFU || OP(rn)==EXACTFU_SS || OP(rn)==EXACTFA || OP(rn)==EXACTFA_NO_TRIE || OP(rn)==EXACTF || OP(rn)==REFF || OP(rn)==NREFF )
#define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL )
#else
/* ... so we use this as its faster. */
-#define IS_TEXT(rn) ( OP(rn)==EXACT )
-#define IS_TEXTFU(rn) ( OP(rn)==EXACTFU || OP(rn)==EXACTFU_SS || OP(rn) == EXACTFA || OP(rn) == EXACTFA_NO_TRIE)
+#define IS_TEXT(rn) ( OP(rn)==EXACT || OP(rn)==EXACTL )
+#define IS_TEXTFU(rn) ( OP(rn)==EXACTFU || OP(rn)==EXACTFLU8 || OP(rn)==EXACTFU_SS || OP(rn) == EXACTFA || OP(rn) == EXACTFA_NO_TRIE)
#define IS_TEXTF(rn) ( OP(rn)==EXACTF )
#define IS_TEXTFL(rn) ( OP(rn)==EXACTFL )
STATIC CHECKPOINT
S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen)
{
- dVAR;
const int retval = PL_savestack_ix;
const int paren_elems_to_push =
(maxopenparen - parenfloor) * REGCP_PAREN_ELEMS;
PERL_ARGS_ASSERT_REGCPPUSH;
if (paren_elems_to_push < 0)
- Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0, maxopenparen: %i parenfloor: %i REGCP_PAREN_ELEMS: %i",
- paren_elems_to_push, maxopenparen, parenfloor, REGCP_PAREN_ELEMS);
+ Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0, maxopenparen: %i parenfloor: %i REGCP_PAREN_ELEMS: %u",
+ (int)paren_elems_to_push, (int)maxopenparen,
+ (int)parenfloor, (unsigned)REGCP_PAREN_ELEMS);
if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems)
Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf
STATIC void
S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p)
{
- dVAR;
UV i;
U32 paren;
GET_RE_DEBUG_FLAGS_DECL;
Perl_croak(aTHX_ "panic: isFOO_lc() has an unexpected character class '%d'", classnum);
}
- assert(0); /* NOTREACHED */
+ NOT_REACHED; /* NOTREACHED */
return FALSE;
}
* '_char_class_number'.
*
* This just calls isFOO_lc on the code point for the character if it is in
- * the range 0-255. Outside that range, all characters avoid Unicode
+ * the range 0-255. Outside that range, all characters use Unicode
* rules, ignoring any locale. So use the Unicode function if this class
* requires a swash, and use the Unicode macro otherwise. */
TWO_BYTE_UTF8_TO_NATIVE(*character, *(character + 1)));
}
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(character, character + UTF8SKIP(character));
+
if (classnum < _FIRST_NON_SWASH_CC) {
/* Initialize the swash unless done already */
case _CC_ENUM_BLANK: return is_HORIZWS_high(character);
case _CC_ENUM_XDIGIT: return is_XDIGIT_high(character);
case _CC_ENUM_VERTSPACE: return is_VERTWS_high(character);
- default: return 0; /* Things like CNTRL are always
- below 256 */
+ default: break;
}
- assert(0); /* NOTREACHED */
- return FALSE;
+ return FALSE; /* Things like CNTRL are always below 256 */
}
/*
}
#endif
-/*
- * Need to implement the following flags for reg_anch:
- *
- * USE_INTUIT_NOML - Useful to call re_intuit_start() first
- * USE_INTUIT_ML
- * INTUIT_AUTORITATIVE_NOML - Can trust a positive answer
- * INTUIT_AUTORITATIVE_ML
- * INTUIT_ONCE_NOML - Intuit can match in one location only.
- * INTUIT_ONCE_ML
- *
- * Another flag for this function: SECOND_TIME (so that float substrs
- * with giant delta may be not rechecked).
- */
-
-/* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
- Otherwise, only SvCUR(sv) is used to get strbeg. */
-/* XXXX Some places assume that there is a fixed substring.
- An update may be needed if optimizer marks as "INTUITable"
- RExen without fixed substrings. Similarly, it is assumed that
- lengths of all the strings are no more than minlen, thus they
- cannot come from lookahead.
- (Or minlen should take into account lookahead.)
- NOTE: Some of this comment is not correct. minlen does now take account
- of lookahead/behind. Further research is required. -- demerphq
-*/
-
-/* A failure to find a constant substring means that there is no need to make
- an expensive call to REx engine, thus we celebrate a failure. Similarly,
- finding a substring too deep into the string means that fewer calls to
- regtry() should be needed.
-
- REx compiler's optimizer found 4 possible hints:
- a) Anchored substring;
- b) Fixed substring;
- c) Whether we are anchored (beginning-of-line or \G);
- d) First node (of those at offset 0) which may distinguish positions;
- We use a)b)d) and multiline-part of c), and try to find a position in the
- string which does not contradict any of them.
- */
-
-/* Most of decisions we do here should have been done at compile time.
- The nodes of the REx which we used for the search should have been
- deleted from the finite automaton. */
-
-/* args:
- * rx: the regex to match against
- * sv: the SV being matched: only used for utf8 flag; the string
- * itself is accessed via the pointers below. Note that on
- * something like an overloaded SV, SvPOK(sv) may be false
- * and the string pointers may point to something unrelated to
- * the SV itself.
- * strbeg: real beginning of string
- * strpos: the point in the string at which to begin matching
- * strend: pointer to the byte following the last char of the string
- * flags currently unused; set to 0
- * data: currently unused; set to NULL
+/* re_intuit_start():
+ *
+ * Based on some optimiser hints, try to find the earliest position in the
+ * string where the regex could match.
+ *
+ * rx: the regex to match against
+ * sv: the SV being matched: only used for utf8 flag; the string
+ * itself is accessed via the pointers below. Note that on
+ * something like an overloaded SV, SvPOK(sv) may be false
+ * and the string pointers may point to something unrelated to
+ * the SV itself.
+ * strbeg: real beginning of string
+ * strpos: the point in the string at which to begin matching
+ * strend: pointer to the byte following the last char of the string
+ * flags currently unused; set to 0
+ * data: currently unused; set to NULL
+ *
+ * The basic idea of re_intuit_start() is to use some known information
+ * about the pattern, namely:
+ *
+ * a) the longest known anchored substring (i.e. one that's at a
+ * constant offset from the beginning of the pattern; but not
+ * necessarily at a fixed offset from the beginning of the
+ * string);
+ * b) the longest floating substring (i.e. one that's not at a constant
+ * offset from the beginning of the pattern);
+ * c) Whether the pattern is anchored to the string; either
+ * an absolute anchor: /^../, or anchored to \n: /^.../m,
+ * or anchored to pos(): /\G/;
+ * d) A start class: a real or synthetic character class which
+ * represents which characters are legal at the start of the pattern;
+ *
+ * to either quickly reject the match, or to find the earliest position
+ * within the string at which the pattern might match, thus avoiding
+ * running the full NFA engine at those earlier locations, only to
+ * eventually fail and retry further along.
+ *
+ * Returns NULL if the pattern can't match, or returns the address within
+ * the string which is the earliest place the match could occur.
+ *
+ * The longest of the anchored and floating substrings is called 'check'
+ * and is checked first. The other is called 'other' and is checked
+ * second. The 'other' substring may not be present. For example,
+ *
+ * /(abc|xyz)ABC\d{0,3}DEFG/
+ *
+ * will have
+ *
+ * check substr (float) = "DEFG", offset 6..9 chars
+ * other substr (anchored) = "ABC", offset 3..3 chars
+ * stclass = [ax]
+ *
+ * Be aware that during the course of this function, sometimes 'anchored'
+ * refers to a substring being anchored relative to the start of the
+ * pattern, and sometimes to the pattern itself being anchored relative to
+ * the string. For example:
+ *
+ * /\dabc/: "abc" is anchored to the pattern;
+ * /^\dabc/: "abc" is anchored to the pattern and the string;
+ * /\d+abc/: "abc" is anchored to neither the pattern nor the string;
+ * /^\d+abc/: "abc" is anchored to neither the pattern nor the string,
+ * but the pattern is anchored to the string.
*/
char *
const U32 flags,
re_scream_pos_data *data)
{
- dVAR;
struct regexp *const prog = ReANY(rx);
- SSize_t start_shift = 0;
+ SSize_t start_shift = prog->check_offset_min;
/* Should be nonnegative! */
SSize_t end_shift = 0;
/* current lowest pos in string where the regex can start matching */
bool ml_anch = 0;
char *other_last = strpos;/* latest pos 'other' substr already checked to */
char *check_at = NULL; /* check substr found at this pos */
- char *checked_upto = NULL; /* how far into the string we have already checked using find_byclass*/
const I32 multiline = prog->extflags & RXf_PMf_MULTILINE;
RXi_GET_DECL(prog,progi);
regmatch_info reginfo_buf; /* create some info to pass to find_byclass */
assert(prog->substrs->data[2].max_offset >= 0);
/* for now, assume that if both present, that the floating substring
- * follows the anchored substring, and that they don't overlap.
+ * doesn't start before the anchored substring.
* If you break this assumption (e.g. doing better optimisations
* with lookahead/behind), then you'll need to audit the code in this
* function carefully first
&& (prog->float_utf8 || prog->float_substr))
|| (prog->float_min_offset >= prog->anchored_offset));
- /* CHR_DIST() would be more correct here but it makes things slow. */
+ /* byte rather than char calculation for efficiency. It fails
+ * to quickly reject some cases that can't match, but will reject
+ * them later after doing full char arithmetic */
if (prog->minlen > strend - strpos) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
" String too short...\n"));
goto fail;
}
+ RX_MATCH_UTF8_set(rx,utf8_target);
reginfo->is_utf8_target = cBOOL(utf8_target);
reginfo->info_aux = NULL;
reginfo->strbeg = strbeg;
});
if (prog->intflags & PREGf_ANCH) { /* Match at \G, beg-of-str or after \n */
- /* Check after \n? */
- ml_anch = ( (prog->intflags & PREGf_ANCH_MBOL)
- || ((prog->intflags & PREGf_ANCH_BOL) && multiline));
- if (!ml_anch) {
+ /* ml_anch: check after \n?
+ *
+ * A note about IMPLICIT: on an un-anchored pattern beginning
+ * with /.*.../, these flags will have been added by the
+ * compiler:
+ * /.*abc/, /.*abc/m: PREGf_IMPLICIT | PREGf_ANCH_MBOL
+ * /.*abc/s: PREGf_IMPLICIT | PREGf_ANCH_SBOL
+ */
+ ml_anch = (prog->intflags & PREGf_ANCH_MBOL)
+ && !(prog->intflags & PREGf_IMPLICIT);
+
+ if (!ml_anch && !(prog->intflags & PREGf_IMPLICIT)) {
/* we are only allowed to match at BOS or \G */
/* trivially reject if there's a BOS anchor and we're not at BOS.
- * In the case of \G, we hope(!) that the caller has already
- * set strpos to pos()-gofs, and will already have checked
- * that this anchor position is legal. So we can skip it here.
+ *
+ * Note that we don't try to do a similar quick reject for
+ * \G, since generally the caller will have calculated strpos
+ * based on pos() and gofs, so the string is already correctly
+ * anchored by definition; and handling the exceptions would
+ * be too fiddly (e.g. REXEC_IGNOREPOS).
*/
- if ( !(prog->intflags & PREGf_ANCH_GPOS)
- && !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
- && (strpos != strbeg))
+ if ( strpos != strbeg
+ && (prog->intflags & PREGf_ANCH_SBOL))
{
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
" Not at start...\n"));
/* in the presence of an anchor, the anchored (relative to the
* start of the regex) substr must also be anchored relative
- * to strpos. So quickly reject if substr isn't found there */
+ * to strpos. So quickly reject if substr isn't found there.
+ * This works for \G too, because the caller will already have
+ * subtracted gofs from pos, and gofs is the offset from the
+ * \G to the start of the regex. For example, in /.abc\Gdef/,
+ * where substr="abcdef", pos()=3, gofs=4, offset_min=1:
+ * caller will have set strpos=pos()-4; we look for the substr
+ * at position pos()-4+1, which lines up with the "a" */
if (prog->check_offset_min == prog->check_offset_max
- && !(prog->intflags & PREGf_CANY_SEEN)
- && ! multiline) /* /m can cause \n's to match that aren't
- accounted for in the string max length.
- See [perl #115242] */
+ && !(prog->intflags & PREGf_CANY_SEEN))
{
/* Substring at constant offset from beg-of-str... */
SSize_t slen = SvCUR(check);
- char *s;
-
- s = HOP3c(strpos, prog->check_offset_min, strend);
+ char *s = HOP3c(strpos, prog->check_offset_min, strend);
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
" Looking for check substr at fixed offset %"IVdf"...\n",
(IV)prog->check_offset_min));
if (SvTAIL(check)) {
- /* In this case, the regex is anchored at the end too,
- * so the lengths must match exactly, give or take a \n.
- * NB: slen >= 1 since the last char of check is \n */
- if ( strend - s > slen || strend - s < slen - 1
- || (strend - s == slen && strend[-1] != '\n'))
+ /* In this case, the regex is anchored at the end too.
+ * Unless it's a multiline match, the lengths must match
+ * exactly, give or take a \n. NB: slen >= 1 since
+ * the last char of check is \n */
+ if (!multiline
+ && ( strend - s > slen
+ || strend - s < slen - 1
+ || (strend - s == slen && strend[-1] != '\n')))
{
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
" String too long...\n"));
}
}
- start_shift = prog->check_offset_min; /* okay to underestimate on CC */
end_shift = prog->check_end_shift;
#ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */
#endif
restart:
- /* Find a candidate regex origin in the region rx_origin..strend
- * by looking for the "check" substring in that region, corrected by
- * start/end_shift.
- */
+ /* This is the (re)entry point of the main loop in this function.
+ * The goal of this loop is to:
+ * 1) find the "check" substring in the region rx_origin..strend
+ * (adjusted by start_shift / end_shift). If not found, reject
+ * immediately.
+ * 2) If it exists, look for the "other" substr too if defined; for
+ * example, if the check substr maps to the anchored substr, then
+ * check the floating substr, and vice-versa. If not found, go
+ * back to (1) with rx_origin suitably incremented.
+ * 3) If we find an rx_origin position that doesn't contradict
+ * either of the substrings, then check the possible additional
+ * constraints on rx_origin of /^.../m or a known start class.
+ * If these fail, then depending on which constraints fail, jump
+ * back to here, or to various other re-entry points further along
+ * that skip some of the first steps.
+ * 4) If we pass all those tests, update the BmUSEFUL() count on the
+ * substring. If the start position was determined to be at the
+ * beginning of the string - so, not rejected, but not optimised,
+ * since we have to run regmatch from position 0 - decrement the
+ * BmUSEFUL() count. Otherwise increment it.
+ */
+
+
+ /* first, look for the 'check' substring */
+
{
U8* start_point;
U8* end_point;
if (prog->intflags & PREGf_CANY_SEEN) {
start_point= (U8*)(rx_origin + start_shift);
end_point= (U8*)(strend - end_shift);
+ if (start_point > end_point)
+ goto fail_finish;
} else {
- start_point= HOP3(rx_origin, start_shift, strend);
- end_point= HOP3(strend, -end_shift, strbeg);
+ end_point = HOP3(strend, -end_shift, strbeg);
+ start_point = HOPMAYBE3(rx_origin, start_shift, end_point);
+ if (!start_point)
+ goto fail_finish;
}
- /* if the regex is absolutely anchored to the start of the string,
- * then check_offset_max represents an upper bound on the string
- * where the substr could start */
+
+ /* If the regex is absolutely anchored to either the start of the
+ * string (SBOL) or to pos() (ANCH_GPOS), then
+ * check_offset_max represents an upper bound on the string where
+ * the substr could start. For the ANCH_GPOS case, we assume that
+ * the caller of intuit will have already set strpos to
+ * pos()-gofs, so in this case strpos + offset_max will still be
+ * an upper bound on the substr.
+ */
if (!ml_anch
&& prog->intflags & PREGf_ANCH
- && prog->check_offset_max != SSize_t_MAX
- && start_shift < prog->check_offset_max)
+ && prog->check_offset_max != SSize_t_MAX)
{
SSize_t len = SvCUR(check) - !!SvTAIL(check);
- end_point = HOP3lim(start_point,
- prog->check_offset_max - start_shift,
- end_point -len)
- + len;
+ const char * const anchor =
+ (prog->intflags & PREGf_ANCH_GPOS ? strpos : strbeg);
+
+ /* do a bytes rather than chars comparison. It's conservative;
+ * so it skips doing the HOP if the result can't possibly end
+ * up earlier than the old value of end_point.
+ */
+ if ((char*)end_point - anchor > prog->check_offset_max) {
+ end_point = HOP3lim((U8*)anchor,
+ prog->check_offset_max,
+ end_point -len)
+ + len;
+ }
}
DEBUG_OPTIMISE_MORE_r({
check_at = fbm_instr( start_point, end_point,
check, multiline ? FBMrf_MULTILINE : 0);
- }
- /* Update the count-of-usability, remove useless subpatterns,
- unshift s. */
-
- DEBUG_EXECUTE_r({
- RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
- SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
- PerlIO_printf(Perl_debug_log, " %s %s substr %s%s%s",
- (check_at ? "Found" : "Did not find"),
- (check == (utf8_target ? prog->anchored_utf8 : prog->anchored_substr)
- ? "anchored" : "floating"),
- quoted,
- RE_SV_TAIL(check),
- (check_at ? " at offset " : "...\n") );
- });
+ /* Update the count-of-usability, remove useless subpatterns,
+ unshift s. */
- if (!check_at)
- goto fail_finish;
- /* Finish the diagnostic message */
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(check_at - strpos)) );
+ DEBUG_EXECUTE_r({
+ RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
+ SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
+ PerlIO_printf(Perl_debug_log, " %s %s substr %s%s%s",
+ (check_at ? "Found" : "Did not find"),
+ (check == (utf8_target ? prog->anchored_utf8 : prog->anchored_substr)
+ ? "anchored" : "floating"),
+ quoted,
+ RE_SV_TAIL(check),
+ (check_at ? " at offset " : "...\n") );
+ });
- /* set rx_origin to the minimum position where the regex could start
- * matching, given the constraint of the just-matched check substring.
- * But don't set it lower than previously.
- */
+ if (!check_at)
+ goto fail_finish;
+ /* Finish the diagnostic message */
+ DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(check_at - strpos)) );
+
+ /* set rx_origin to the minimum position where the regex could start
+ * matching, given the constraint of the just-matched check substring.
+ * But don't set it lower than previously.
+ */
- if (check_at - rx_origin > prog->check_offset_max)
- rx_origin = HOP3c(check_at, -prog->check_offset_max, rx_origin);
+ if (check_at - rx_origin > prog->check_offset_max)
+ rx_origin = HOP3c(check_at, -prog->check_offset_max, rx_origin);
+ }
- /* XXX dmq: first branch is for positive lookbehind...
- Our check string is offset from the beginning of the pattern.
- So we need to do any stclass tests offset forward from that
- point. I think. :-(
- */
-
- /* Got a candidate. Check MBOL anchoring, and the *other* substr.
- Start with the other substr.
- XXXX no SCREAM optimization yet - and a very coarse implementation
- XXXX /ttx+/ results in anchored="ttx", floating="x". floating will
- *always* match. Probably should be marked during compile...
- Probably it is right to do no SCREAM here...
- */
+ /* now look for the 'other' substring if defined */
if (utf8_target ? prog->substrs->data[other_ix].utf8_substr
: prog->substrs->data[other_ix].substr)
postprocess_substr_matches:
- /* handle the extra constraint of /^/m */
+ /* handle the extra constraint of /^.../m if present */
- if (ml_anch && rx_origin != strbeg && rx_origin[-1] != '\n'
- /* May be due to an implicit anchor of m{.*foo} */
- && !(prog->intflags & PREGf_IMPLICIT))
- {
+ if (ml_anch && rx_origin != strbeg && rx_origin[-1] != '\n') {
char *s;
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
}
else {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- " Starting position does not contradict /%s^%s/m...\n",
- PL_colors[0], PL_colors[1]));
+ " (multiline anchor test skipped)\n"));
}
+ success_at_start:
- /* Decide whether using the substrings helped */
-
- if (rx_origin != strpos) {
- /* Fixed substring is found far enough so that the match
- cannot start at strpos. */
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " try at offset...\n"));
- ++BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr); /* hooray/5 */
- }
- else {
- /* The found string does not prohibit matching at strpos,
- - no optimization of calling REx engine can be performed,
- unless it was an MBOL and we are not after MBOL,
- or a future STCLASS check will fail this. */
- success_at_start:
- if (!(prog->intflags & PREGf_NAUGHTY) /* XXXX If strpos moved? */
- && (utf8_target ? (
- prog->check_utf8 /* Could be deleted already */
- && --BmUSEFUL(prog->check_utf8) < 0
- && (prog->check_utf8 == prog->float_utf8)
- ) : (
- prog->check_substr /* Could be deleted already */
- && --BmUSEFUL(prog->check_substr) < 0
- && (prog->check_substr == prog->float_substr)
- )))
- {
- /* If flags & SOMETHING - do not do it many times on the same match */
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " ... Disabling check substring...\n"));
- /* XXX Does the destruction order has to change with utf8_target? */
- SvREFCNT_dec(utf8_target ? prog->check_utf8 : prog->check_substr);
- SvREFCNT_dec(utf8_target ? prog->check_substr : prog->check_utf8);
- prog->check_substr = prog->check_utf8 = NULL; /* disable */
- prog->float_substr = prog->float_utf8 = NULL; /* clear */
- check = NULL; /* abort */
- /* XXXX If the check string was an implicit check MBOL, then we need to unset the relevant flag
- see http://bugs.activestate.com/show_bug.cgi?id=87173 */
- if (prog->intflags & PREGf_IMPLICIT) {
- prog->intflags &= ~PREGf_ANCH_MBOL;
- /* maybe we have no anchors left after this... */
- if (!(prog->intflags & PREGf_ANCH))
- prog->extflags &= ~RXf_IS_ANCHORED;
- }
- /* XXXX This is a remnant of the old implementation. It
- looks wasteful, since now INTUIT can use many
- other heuristics. */
- prog->extflags &= ~RXf_USE_INTUIT;
- /* XXXX What other flags might need to be cleared in this branch? */
- }
- }
+ /* if we have a starting character class, then test that extra constraint.
+ * (trie stclasses are too expensive to use here, we are better off to
+ * leave it to regmatch itself) */
- /* Last resort... */
- /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
- /* trie stclasses are too expensive to use here, we are better off to
- leave it to regmatch itself */
if (progi->regstclass && PL_regkind[OP(progi->regstclass)]!=TRIE) {
- /* minlen == 0 is possible if regstclass is \b or \B,
- and the fixed substr is ''$.
- Since minlen is already taken into account, rx_origin+1 is before strend;
- accidentally, minlen >= 1 guaranties no false positives at rx_origin + 1
- even for \b or \B. But (minlen? 1 : 0) below assumes that
- regstclass does not come from lookahead... */
- /* If regstclass takes bytelength more than 1: If charlength==1, OK.
- This leaves EXACTF-ish only, which are dealt with in find_byclass(). */
const U8* const str = (U8*)STRING(progi->regstclass);
/* XXX this value could be pre-computed */
: 1);
char * endpos;
char *s;
+ /* latest pos that a matching float substr constrains rx start to */
+ char *rx_max_float = NULL;
+
+ /* if the current rx_origin is anchored, either by satisfying an
+ * anchored substring constraint, or a /^.../m constraint, then we
+ * can reject the current origin if the start class isn't found
+ * at the current position. If we have a float-only match, then
+ * rx_origin is constrained to a range; so look for the start class
+ * in that range. if neither, then look for the start class in the
+ * whole rest of the string */
+
+ /* XXX DAPM it's not clear what the minlen test is for, and why
+ * it's not used in the floating case. Nothing in the test suite
+ * causes minlen == 0 here. See <20140313134639.GS12844@iabyn.com>.
+ * Here are some old comments, which may or may not be correct:
+ *
+ * minlen == 0 is possible if regstclass is \b or \B,
+ * and the fixed substr is ''$.
+ * Since minlen is already taken into account, rx_origin+1 is
+ * before strend; accidentally, minlen >= 1 guaranties no false
+ * positives at rx_origin + 1 even for \b or \B. But (minlen? 1 :
+ * 0) below assumes that regstclass does not come from lookahead...
+ * If regstclass takes bytelength more than 1: If charlength==1, OK.
+ * This leaves EXACTF-ish only, which are dealt with in
+ * find_byclass().
+ */
+
if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
endpos= HOP3c(rx_origin, (prog->minlen ? cl_l : 0), strend);
- else if (prog->float_substr || prog->float_utf8)
- endpos= HOP3c(HOP3c(check_at, -start_shift, strbeg), cl_l, strend);
+ else if (prog->float_substr || prog->float_utf8) {
+ rx_max_float = HOP3c(check_at, -start_shift, strbeg);
+ endpos= HOP3c(rx_max_float, cl_l, strend);
+ }
else
endpos= strend;
- if (checked_upto < rx_origin)
- checked_upto = rx_origin;
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
" looking for class: start_shift: %"IVdf" check_at: %"IVdf
- " rx_origin: %"IVdf" endpos: %"IVdf" checked_upto: %"IVdf"\n",
+ " rx_origin: %"IVdf" endpos: %"IVdf"\n",
(IV)start_shift, (IV)(check_at - strbeg),
- (IV)(rx_origin - strbeg), (IV)(endpos - strbeg),
- (IV)(checked_upto- strbeg)));
+ (IV)(rx_origin - strbeg), (IV)(endpos - strbeg)));
- s = find_byclass(prog, progi->regstclass, checked_upto, endpos,
+ s = find_byclass(prog, progi->regstclass, rx_origin, endpos,
reginfo);
- if (s) {
- checked_upto = s;
- } else {
-#ifdef DEBUGGING
- const char *what = NULL;
-#endif
+ if (!s) {
if (endpos == strend) {
DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
" Could not match STCLASS...\n") );
}
DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
" This position contradicts STCLASS...\n") );
- if ((prog->intflags & PREGf_ANCH) && !ml_anch)
+ if ((prog->intflags & PREGf_ANCH) && !ml_anch
+ && !(prog->intflags & PREGf_IMPLICIT))
goto fail;
- checked_upto = HOPBACKc(endpos, start_shift);
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " start_shift: %"IVdf" check_at: %"IVdf" endpos: %"IVdf" checked_upto: %"IVdf"\n",
- (IV)start_shift, (IV)(check_at - strbeg), (IV)(endpos - strbeg), (IV)(checked_upto- strbeg)));
+
/* Contradict one of substrings */
if (prog->anchored_substr || prog->anchored_utf8) {
- if (prog->substrs->check_ix == 0) { /* check is anchored */
- DEBUG_EXECUTE_r( what = "anchored" );
- hop_and_restart:
- rx_origin = HOP3c(rx_origin, 1, strend);
- if (rx_origin + start_shift + end_shift > strend) {
- /* XXXX Should be taken into account earlier? */
- DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
- " Could not match STCLASS...\n") );
- goto fail;
- }
- DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
- " Looking for %s substr starting at offset %ld...\n",
- what, (long)(rx_origin + start_shift - strpos)) );
- goto restart;
- }
- /* Have both, check_string is floating */
- if (rx_origin + start_shift >= check_at) /* Contradicts floating=check */
- goto retry_floating_check;
- /* Recheck anchored substring, but not floating... */
- if (!check) {
- rx_origin = NULL;
- goto giveup;
+ if (prog->substrs->check_ix == 1) { /* check is float */
+ /* Have both, check_string is floating */
+ assert(rx_origin + start_shift <= check_at);
+ if (rx_origin + start_shift != check_at) {
+ /* not at latest position float substr could match:
+ * Recheck anchored substring, but not floating.
+ * The condition above is in bytes rather than
+ * chars for efficiency. It's conservative, in
+ * that it errs on the side of doing 'goto
+ * do_other_substr', where a more accurate
+ * char-based calculation will be done */
+ DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
+ " Looking for anchored substr starting at offset %ld...\n",
+ (long)(other_last - strpos)) );
+ goto do_other_substr;
+ }
}
- DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
- " Looking for anchored substr starting at offset %ld...\n",
- (long)(other_last - strpos)) );
- assert(prog->substrs->check_ix); /* other is float */
- goto do_other_substr;
- }
- /* Another way we could have checked stclass at the
- current position only: */
- if (ml_anch) {
- rx_origin++;
- if (!check)
- goto giveup;
- DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
- " Looking for /%s^%s/m starting at offset %ld...\n",
- PL_colors[0], PL_colors[1],
- (long)(rx_origin - strpos)) );
- /* XXX DAPM I don't yet know why this is true, but the code
- * assumed it when it used to do goto try_at_offset */
- assert(rx_origin != strpos);
- goto postprocess_substr_matches;
- }
- if (!(utf8_target ? prog->float_utf8 : prog->float_substr)) /* Could have been deleted */
- goto fail;
- /* Check is floating substring. */
- retry_floating_check:
- rx_origin = check_at - start_shift;
- DEBUG_EXECUTE_r( what = "floating" );
- goto hop_and_restart;
+ }
+ else {
+ /* float-only */
+
+ if (ml_anch) {
+ /* In the presence of ml_anch, we might be able to
+ * find another \n without breaking the current float
+ * constraint. */
+
+ /* strictly speaking this should be HOP3c(..., 1, ...),
+ * but since we goto a block of code that's going to
+ * search for the next \n if any, its safe here */
+ rx_origin++;
+ DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
+ " Looking for /%s^%s/m starting at offset %ld...\n",
+ PL_colors[0], PL_colors[1],
+ (long)(rx_origin - strpos)) );
+ goto postprocess_substr_matches;
+ }
+
+ /* strictly speaking this can never be true; but might
+ * be if we ever allow intuit without substrings */
+ if (!(utf8_target ? prog->float_utf8 : prog->float_substr))
+ goto fail;
+
+ rx_origin = rx_max_float;
+ }
+
+ /* at this point, any matching substrings have been
+ * contradicted. Start again... */
+
+ rx_origin = HOP3c(rx_origin, 1, strend);
+
+ /* uses bytes rather than char calculations for efficiency.
+ * It's conservative: it errs on the side of doing 'goto restart',
+ * where there is code that does a proper char-based test */
+ if (rx_origin + start_shift + end_shift > strend) {
+ DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
+ " Could not match STCLASS...\n") );
+ goto fail;
+ }
+ DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
+ " Looking for %s substr starting at offset %ld...\n",
+ (prog->substrs->check_ix ? "floating" : "anchored"),
+ (long)(rx_origin + start_shift - strpos)) );
+ goto restart;
}
+
+ /* Success !!! */
+
if (rx_origin != s) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
" By STCLASS: moving %ld --> %ld\n",
);
}
}
- giveup:
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Intuit: %s%s:%s match at offset %ld\n",
- PL_colors[4], (check ? "Successfully guessed" : "Giving up"),
- PL_colors[5], (long)(rx_origin - strpos)) );
+
+ /* Decide whether using the substrings helped */
+
+ if (rx_origin != strpos) {
+ /* Fixed substring is found far enough so that the match
+ cannot start at strpos. */
+
+ DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " try at offset...\n"));
+ ++BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr); /* hooray/5 */
+ }
+ else {
+ /* The found rx_origin position does not prohibit matching at
+ * strpos, so calling intuit didn't gain us anything. Decrement
+ * the BmUSEFUL() count on the check substring, and if we reach
+ * zero, free it. */
+ if (!(prog->intflags & PREGf_NAUGHTY)
+ && (utf8_target ? (
+ prog->check_utf8 /* Could be deleted already */
+ && --BmUSEFUL(prog->check_utf8) < 0
+ && (prog->check_utf8 == prog->float_utf8)
+ ) : (
+ prog->check_substr /* Could be deleted already */
+ && --BmUSEFUL(prog->check_substr) < 0
+ && (prog->check_substr == prog->float_substr)
+ )))
+ {
+ /* If flags & SOMETHING - do not do it many times on the same match */
+ DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " ... Disabling check substring...\n"));
+ /* XXX Does the destruction order has to change with utf8_target? */
+ SvREFCNT_dec(utf8_target ? prog->check_utf8 : prog->check_substr);
+ SvREFCNT_dec(utf8_target ? prog->check_substr : prog->check_utf8);
+ prog->check_substr = prog->check_utf8 = NULL; /* disable */
+ prog->float_substr = prog->float_utf8 = NULL; /* clear */
+ check = NULL; /* abort */
+ /* XXXX This is a remnant of the old implementation. It
+ looks wasteful, since now INTUIT can use many
+ other heuristics. */
+ prog->extflags &= ~RXf_USE_INTUIT;
+ }
+ }
+
+ DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
+ "Intuit: %sSuccessfully guessed:%s match at offset %ld\n",
+ PL_colors[4], PL_colors[5], (long)(rx_origin - strpos)) );
+
return rx_origin;
fail_finish: /* Substring not found */
return NULL;
}
+
#define DECL_TRIE_TYPE(scan) \
- const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold, \
- trie_utf8_exactfa_fold, trie_latin_utf8_exactfa_fold } \
- trie_type = ((scan->flags == EXACT) \
- ? (utf8_target ? trie_utf8 : trie_plain) \
- : (scan->flags == EXACTFA) \
- ? (utf8_target ? trie_utf8_exactfa_fold : trie_latin_utf8_exactfa_fold) \
- : (utf8_target ? trie_utf8_fold : trie_latin_utf8_fold))
+ const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold, \
+ trie_utf8_exactfa_fold, trie_latin_utf8_exactfa_fold, \
+ trie_utf8l, trie_flu8 } \
+ trie_type = ((scan->flags == EXACT) \
+ ? (utf8_target ? trie_utf8 : trie_plain) \
+ : (scan->flags == EXACTL) \
+ ? (utf8_target ? trie_utf8l : trie_plain) \
+ : (scan->flags == EXACTFA) \
+ ? (utf8_target \
+ ? trie_utf8_exactfa_fold \
+ : trie_latin_utf8_exactfa_fold) \
+ : (scan->flags == EXACTFLU8 \
+ ? trie_flu8 \
+ : (utf8_target \
+ ? trie_utf8_fold \
+ : trie_latin_utf8_fold)))
#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len, uvc, charid, foldlen, foldbuf, uniflags) \
STMT_START { \
STRLEN skiplen; \
U8 flags = FOLD_FLAGS_FULL; \
switch (trie_type) { \
+ case trie_flu8: \
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE; \
+ if (utf8_target && UTF8_IS_ABOVE_LATIN1(*uc)) { \
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc + UTF8SKIP(uc)); \
+ } \
+ goto do_trie_utf8_fold; \
case trie_utf8_exactfa_fold: \
flags |= FOLD_FLAGS_NOMIX_ASCII; \
- /* FALL THROUGH */ \
+ /* FALLTHROUGH */ \
case trie_utf8_fold: \
+ do_trie_utf8_fold: \
if ( foldlen>0 ) { \
uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \
foldlen -= len; \
break; \
case trie_latin_utf8_exactfa_fold: \
flags |= FOLD_FLAGS_NOMIX_ASCII; \
- /* FALL THROUGH */ \
+ /* FALLTHROUGH */ \
case trie_latin_utf8_fold: \
if ( foldlen>0 ) { \
uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \
uscan = foldbuf + skiplen; \
} \
break; \
+ case trie_utf8l: \
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE; \
+ if (utf8_target && UTF8_IS_ABOVE_LATIN1(*uc)) { \
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc + UTF8SKIP(uc)); \
+ } \
+ /* FALLTHROUGH */ \
case trie_utf8: \
uvc = utf8n_to_uvchr( (const U8*) uc, UTF8_MAXLEN, &len, uniflags ); \
break; \
} \
} STMT_END
-#define REXEC_FBC_EXACTISH_SCAN(CoNd) \
+#define DUMP_EXEC_POS(li,s,doutf8) \
+ dump_exec_pos(li,s,(reginfo->strend),(reginfo->strbeg), \
+ startpos, doutf8)
+
+#define REXEC_FBC_EXACTISH_SCAN(COND) \
STMT_START { \
while (s <= e) { \
- if ( (CoNd) \
+ if ( (COND) \
&& (ln == 1 || folder(s, pat_string, ln)) \
&& (reginfo->intuit || regtry(reginfo, &s)) )\
goto got_it; \
} \
} STMT_END
-#define REXEC_FBC_UTF8_SCAN(CoDe) \
+#define REXEC_FBC_UTF8_SCAN(CODE) \
STMT_START { \
while (s < strend) { \
- CoDe \
+ CODE \
s += UTF8SKIP(s); \
} \
} STMT_END
-#define REXEC_FBC_SCAN(CoDe) \
+#define REXEC_FBC_SCAN(CODE) \
STMT_START { \
while (s < strend) { \
- CoDe \
+ CODE \
s++; \
} \
} STMT_END
-#define REXEC_FBC_UTF8_CLASS_SCAN(CoNd) \
-REXEC_FBC_UTF8_SCAN( \
- if (CoNd) { \
- if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \
- goto got_it; \
- else \
- tmp = doevery; \
- } \
- else \
- tmp = 1; \
+#define REXEC_FBC_UTF8_CLASS_SCAN(COND) \
+REXEC_FBC_UTF8_SCAN( /* Loops while (s < strend) */ \
+ if (COND) { \
+ if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \
+ goto got_it; \
+ else \
+ tmp = doevery; \
+ } \
+ else \
+ tmp = 1; \
)
-#define REXEC_FBC_CLASS_SCAN(CoNd) \
-REXEC_FBC_SCAN( \
- if (CoNd) { \
- if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \
- goto got_it; \
- else \
- tmp = doevery; \
- } \
- else \
- tmp = 1; \
+#define REXEC_FBC_CLASS_SCAN(COND) \
+REXEC_FBC_SCAN( /* Loops while (s < strend) */ \
+ if (COND) { \
+ if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \
+ goto got_it; \
+ else \
+ tmp = doevery; \
+ } \
+ else \
+ tmp = 1; \
)
-#define REXEC_FBC_TRYIT \
-if ((reginfo->intuit || regtry(reginfo, &s))) \
- goto got_it
-
-#define REXEC_FBC_CSCAN(CoNdUtF8,CoNd) \
+#define REXEC_FBC_CSCAN(CONDUTF8,COND) \
if (utf8_target) { \
- REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8); \
+ REXEC_FBC_UTF8_CLASS_SCAN(CONDUTF8); \
} \
else { \
- REXEC_FBC_CLASS_SCAN(CoNd); \
+ REXEC_FBC_CLASS_SCAN(COND); \
}
-
-#define DUMP_EXEC_POS(li,s,doutf8) \
- dump_exec_pos(li,s,(reginfo->strend),(reginfo->strbeg), \
- startpos, doutf8)
-
-
-#define UTF8_NOLOAD(TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \
- tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n'; \
- tmp = TEST_NON_UTF8(tmp); \
- REXEC_FBC_UTF8_SCAN( \
- if (tmp == ! TEST_NON_UTF8((U8) *s)) { \
- tmp = !tmp; \
- IF_SUCCESS; \
- } \
- else { \
- IF_FAIL; \
- } \
- ); \
-#define UTF8_LOAD(TeSt1_UtF8, TeSt2_UtF8, IF_SUCCESS, IF_FAIL) \
- if (s == reginfo->strbeg) { \
- tmp = '\n'; \
- } \
- else { \
- U8 * const r = reghop3((U8*)s, -1, (U8*)reginfo->strbeg); \
- tmp = utf8n_to_uvchr(r, (U8*) reginfo->strend - r, \
+/* The three macros below are slightly different versions of the same logic.
+ *
+ * The first is for /a and /aa when the target string is UTF-8. This can only
+ * match ascii, but it must advance based on UTF-8. The other two handle the
+ * non-UTF-8 and the more generic UTF-8 cases. In all three, we are looking
+ * for the boundary (or non-boundary) between a word and non-word character.
+ * The utf8 and non-utf8 cases have the same logic, but the details must be
+ * different. Find the "wordness" of the character just prior to this one, and
+ * compare it with the wordness of this one. If they differ, we have a
+ * boundary. At the beginning of the string, pretend that the previous
+ * character was a new-line.
+ *
+ * All these macros uncleanly have side-effects with each other and outside
+ * variables. So far it's been too much trouble to clean-up
+ *
+ * TEST_NON_UTF8 is the macro or function to call to test if its byte input is
+ * a word character or not.
+ * IF_SUCCESS is code to do if it finds that we are at a boundary between
+ * word/non-word
+ * IF_FAIL is code to do if we aren't at a boundary between word/non-word
+ *
+ * Exactly one of the two IF_FOO parameters is a no-op, depending on whether we
+ * are looking for a boundary or for a non-boundary. If we are looking for a
+ * boundary, we want IF_FAIL to be the no-op, and for IF_SUCCESS to go out and
+ * see if this tentative match actually works, and if so, to quit the loop
+ * here. And vice-versa if we are looking for a non-boundary.
+ *
+ * 'tmp' below in the next three macros in the REXEC_FBC_SCAN and
+ * REXEC_FBC_UTF8_SCAN loops is a loop invariant, a bool giving the return of
+ * TEST_NON_UTF8(s-1). To see this, note that that's what it is defined to be
+ * at entry to the loop, and to get to the IF_FAIL branch, tmp must equal
+ * TEST_NON_UTF8(s), and in the opposite branch, IF_SUCCESS, tmp is that
+ * complement. But in that branch we complement tmp, meaning that at the
+ * bottom of the loop tmp is always going to be equal to TEST_NON_UTF8(s),
+ * which means at the top of the loop in the next iteration, it is
+ * TEST_NON_UTF8(s-1) */
+#define FBC_UTF8_A(TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \
+ tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n'; \
+ tmp = TEST_NON_UTF8(tmp); \
+ REXEC_FBC_UTF8_SCAN( /* advances s while s < strend */ \
+ if (tmp == ! TEST_NON_UTF8((U8) *s)) { \
+ tmp = !tmp; \
+ IF_SUCCESS; /* Is a boundary if values for s-1 and s differ */ \
+ } \
+ else { \
+ IF_FAIL; \
+ } \
+ ); \
+
+/* Like FBC_UTF8_A, but TEST_UV is a macro which takes a UV as its input, and
+ * TEST_UTF8 is a macro that for the same input code points returns identically
+ * to TEST_UV, but takes a pointer to a UTF-8 encoded string instead */
+#define FBC_UTF8(TEST_UV, TEST_UTF8, IF_SUCCESS, IF_FAIL) \
+ if (s == reginfo->strbeg) { \
+ tmp = '\n'; \
+ } \
+ else { /* Back-up to the start of the previous character */ \
+ U8 * const r = reghop3((U8*)s, -1, (U8*)reginfo->strbeg); \
+ tmp = utf8n_to_uvchr(r, (U8*) reginfo->strend - r, \
0, UTF8_ALLOW_DEFAULT); \
- } \
- tmp = TeSt1_UtF8; \
- LOAD_UTF8_CHARCLASS_ALNUM(); \
- REXEC_FBC_UTF8_SCAN( \
- if (tmp == ! (TeSt2_UtF8)) { \
- tmp = !tmp; \
- IF_SUCCESS; \
- } \
- else { \
- IF_FAIL; \
- } \
- ); \
+ } \
+ tmp = TEST_UV(tmp); \
+ LOAD_UTF8_CHARCLASS_ALNUM(); \
+ REXEC_FBC_UTF8_SCAN( /* advances s while s < strend */ \
+ if (tmp == ! (TEST_UTF8((U8 *) s))) { \
+ tmp = !tmp; \
+ IF_SUCCESS; \
+ } \
+ else { \
+ IF_FAIL; \
+ } \
+ );
-/* The only difference between the BOUND and NBOUND cases is that
- * REXEC_FBC_TRYIT is called when matched in BOUND, and when non-matched in
- * NBOUND. This is accomplished by passing it in either the if or else clause,
- * with the other one being empty */
-#define FBC_BOUND(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
- FBC_BOUND_COMMON(UTF8_LOAD(TEST1_UTF8, TEST2_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
-
-#define FBC_BOUND_NOLOAD(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
- FBC_BOUND_COMMON(UTF8_NOLOAD(TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
-
-#define FBC_NBOUND(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
- FBC_BOUND_COMMON(UTF8_LOAD(TEST1_UTF8, TEST2_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
-
-#define FBC_NBOUND_NOLOAD(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
- FBC_BOUND_COMMON(UTF8_NOLOAD(TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
-
-
-/* Common to the BOUND and NBOUND cases. Unfortunately the UTF8 tests need to
- * be passed in completely with the variable name being tested, which isn't
- * such a clean interface, but this is easier to read than it was before. We
- * are looking for the boundary (or non-boundary between a word and non-word
- * character. The utf8 and non-utf8 cases have the same logic, but the details
- * must be different. Find the "wordness" of the character just prior to this
- * one, and compare it with the wordness of this one. If they differ, we have
- * a boundary. At the beginning of the string, pretend that the previous
- * character was a new-line */
+/* Like the above two macros. UTF8_CODE is the complete code for handling
+ * UTF-8. Common to the BOUND and NBOUND cases, set-up by the FBC_BOUND, etc
+ * macros below */
#define FBC_BOUND_COMMON(UTF8_CODE, TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \
if (utf8_target) { \
- UTF8_CODE \
+ UTF8_CODE \
} \
else { /* Not utf8 */ \
tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n'; \
tmp = TEST_NON_UTF8(tmp); \
- REXEC_FBC_SCAN( \
+ REXEC_FBC_SCAN( /* advances s while s < strend */ \
if (tmp == ! TEST_NON_UTF8((U8) *s)) { \
- tmp = !tmp; \
IF_SUCCESS; \
+ tmp = !tmp; \
} \
else { \
IF_FAIL; \
} \
); \
} \
- if ((!prog->minlen && tmp) && (reginfo->intuit || regtry(reginfo, &s))) \
- goto got_it;
+ /* Here, things have been set up by the previous code so that tmp is the \
+ * return of TEST_NON_UTF(s-1) or TEST_UTF8(s-1) (depending on the \
+ * utf8ness of the target). We also have to check if this matches against \
+ * the EOS, which we treat as a \n (which is the same value in both UTF-8 \
+ * or non-UTF8, so can use the non-utf8 test condition even for a UTF-8 \
+ * string */ \
+ if (tmp == ! TEST_NON_UTF8('\n')) { \
+ IF_SUCCESS; \
+ } \
+ else { \
+ IF_FAIL; \
+ }
+
+/* This is the macro to use when we want to see if something that looks like it
+ * could match, actually does, and if so exits the loop */
+#define REXEC_FBC_TRYIT \
+ if ((reginfo->intuit || regtry(reginfo, &s))) \
+ goto got_it
+
+/* The only difference between the BOUND and NBOUND cases is that
+ * REXEC_FBC_TRYIT is called when matched in BOUND, and when non-matched in
+ * NBOUND. This is accomplished by passing it as either the if or else clause,
+ * with the other one being empty (PLACEHOLDER is defined as empty).
+ *
+ * The TEST_FOO parameters are for operating on different forms of input, but
+ * all should be ones that return identically for the same underlying code
+ * points */
+#define FBC_BOUND(TEST_NON_UTF8, TEST_UV, TEST_UTF8) \
+ FBC_BOUND_COMMON( \
+ FBC_UTF8(TEST_UV, TEST_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), \
+ TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
+
+#define FBC_BOUND_A(TEST_NON_UTF8, TEST_UV, TEST_UTF8) \
+ FBC_BOUND_COMMON( \
+ FBC_UTF8_A(TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), \
+ TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
+
+#define FBC_NBOUND(TEST_NON_UTF8, TEST_UV, TEST_UTF8) \
+ FBC_BOUND_COMMON( \
+ FBC_UTF8(TEST_UV, TEST_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), \
+ TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
+
+#define FBC_NBOUND_A(TEST_NON_UTF8, TEST_UV, TEST_UTF8) \
+ FBC_BOUND_COMMON( \
+ FBC_UTF8_A(TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), \
+ TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
+
/* We know what class REx starts with. Try to find this position... */
/* if reginfo->intuit, its a dryrun */
/* annoyingly all the vars in this routine have different names from their counterparts
in regmatch. /grrr */
-
STATIC char *
S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
const char *strend, regmatch_info *reginfo)
/* We know what class it must start with. */
switch (OP(c)) {
+ case ANYOFL:
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ /* FALLTHROUGH */
case ANYOF:
if (utf8_target) {
REXEC_FBC_UTF8_CLASS_SCAN(
case EXACTFA_NO_TRIE: /* This node only generated for non-utf8 patterns */
assert(! is_utf8_pat);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case EXACTFA:
if (is_utf8_pat || utf8_target) {
utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
goto do_exactf_non_utf8;
case EXACTFL:
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
if (is_utf8_pat || utf8_target || IN_UTF8_CTYPE_LOCALE) {
utf8_fold_flags = FOLDEQ_LOCALE;
goto do_exactf_utf8;
}
goto do_exactf_utf8;
+ case EXACTFLU8:
+ if (! utf8_target) { /* All code points in this node require
+ UTF-8 to express. */
+ break;
+ }
+ utf8_fold_flags = FOLDEQ_LOCALE | FOLDEQ_S2_ALREADY_FOLDED
+ | FOLDEQ_S2_FOLDS_SANE;
+ goto do_exactf_utf8;
+
case EXACTFU:
if (is_utf8_pat || utf8_target) {
utf8_fold_flags = is_utf8_pat ? FOLDEQ_S2_ALREADY_FOLDED : 0;
fold_array = PL_fold_latin1;
folder = foldEQ_latin1;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
do_exactf_non_utf8: /* Neither pattern nor string are UTF8, and there
are no glitches with fold-length differences
}
break;
}
+
case BOUNDL:
- FBC_BOUND(isWORDCHAR_LC,
- isWORDCHAR_LC_uvchr(tmp),
- isWORDCHAR_LC_utf8((U8*)s));
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ FBC_BOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8);
break;
case NBOUNDL:
- FBC_NBOUND(isWORDCHAR_LC,
- isWORDCHAR_LC_uvchr(tmp),
- isWORDCHAR_LC_utf8((U8*)s));
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ FBC_NBOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8);
break;
case BOUND:
- FBC_BOUND(isWORDCHAR,
- isWORDCHAR_uni(tmp),
- cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target)));
+ FBC_BOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8);
break;
case BOUNDA:
- FBC_BOUND_NOLOAD(isWORDCHAR_A,
- isWORDCHAR_A(tmp),
- isWORDCHAR_A((U8*)s));
+ FBC_BOUND_A(isWORDCHAR_A, isWORDCHAR_A, isWORDCHAR_A);
break;
case NBOUND:
- FBC_NBOUND(isWORDCHAR,
- isWORDCHAR_uni(tmp),
- cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target)));
+ FBC_NBOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8);
break;
case NBOUNDA:
- FBC_NBOUND_NOLOAD(isWORDCHAR_A,
- isWORDCHAR_A(tmp),
- isWORDCHAR_A((U8*)s));
+ FBC_NBOUND_A(isWORDCHAR_A, isWORDCHAR_A, isWORDCHAR_A);
break;
case BOUNDU:
- FBC_BOUND(isWORDCHAR_L1,
- isWORDCHAR_uni(tmp),
- cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target)));
+ FBC_BOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8);
break;
case NBOUNDU:
- FBC_NBOUND(isWORDCHAR_L1,
- isWORDCHAR_uni(tmp),
- cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target)));
+ FBC_NBOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8);
break;
case LNBREAK:
REXEC_FBC_CSCAN(is_LNBREAK_utf8_safe(s, strend),
/* FALLTHROUGH */
case POSIXL:
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
REXEC_FBC_CSCAN(to_complement ^ cBOOL(isFOO_utf8_lc(FLAGS(c), (U8 *) s)),
to_complement ^ cBOOL(isFOO_lc(FLAGS(c), *s)));
break;
case NPOSIXA:
if (utf8_target) {
/* The complement of something that matches only ASCII matches all
- * UTF-8 variant code points, plus everything in ASCII that isn't
- * in the class */
- REXEC_FBC_UTF8_CLASS_SCAN(! UTF8_IS_INVARIANT(*s)
+ * non-ASCII, plus everything in ASCII that isn't in the class. */
+ REXEC_FBC_UTF8_CLASS_SCAN(! isASCII_utf8(s)
|| ! _generic_isCC_A(*s, FLAGS(c)));
break;
}
macros */
case _CC_ENUM_SPACE: /* XXX would require separate code if we
revert the change of \v matching this */
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case _CC_ENUM_PSXSPC:
REXEC_FBC_UTF8_CLASS_SCAN(
default:
Perl_croak(aTHX_ "panic: find_byclass() node %d='%s' has an unexpected character class '%d'", OP(c), PL_reg_name[OP(c)], classnum);
- assert(0); /* NOTREACHED */
+ NOT_REACHED; /* NOTREACHED */
}
}
break;
break;
default:
Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
- break;
}
return 0;
got_it:
/* flags: For optimizations. See REXEC_* in regexp.h */
{
- dVAR;
struct regexp *const prog = ReANY(rx);
char *s;
regnode *c;
/* Be paranoid... */
if (prog == NULL || stringarg == NULL) {
Perl_croak(aTHX_ "NULL regexp parameter");
- return 0;
}
DEBUG_EXECUTE_r(
Perl_croak(aTHX_ "corrupted regexp program");
}
+ RX_MATCH_TAINTED_off(rx);
+ RX_MATCH_UTF8_set(rx, utf8_target);
+
reginfo->prog = rx; /* Yes, sorry that this is confusing. */
reginfo->intuit = 0;
reginfo->is_utf8_target = cBOOL(utf8_target);
magic belonging to this SV.
Not newSVsv, either, as it does not COW.
*/
- assert(!IS_PADGV(sv));
reginfo->sv = newSV(0);
SvSetSV_nosteal(reginfo->sv, sv);
SAVEFREESV(reginfo->sv);
}
/* Simplest case: anchored match need be tried only once. */
- /* [unless only anchor is BOL and multiline is set] */
+ /* [unless only anchor is MBOL - implying multiline is set] */
if (prog->intflags & (PREGf_ANCH & ~PREGf_ANCH_GPOS)) {
if (s == startpos && regtry(reginfo, &s))
goto got_it;
}
DEBUG_EXECUTE_r({
SV * const prop = sv_newmortal();
- regprop(prog, prop, c, reginfo);
+ regprop(prog, prop, c, reginfo, NULL);
{
RE_PV_QUOTED_DECL(quoted,utf8_target,PERL_DEBUG_PAD_ZERO(1),
s,strend-s,60);
* and replaced it with this one. Yves */
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
- "String does not contain required substring, cannot match.\n"
+ "%sString does not contain required substring, cannot match.%s\n",
+ PL_colors[4], PL_colors[5]
));
goto phooey;
}
/* Failure. */
goto phooey;
-got_it:
+ got_it:
/* s/// doesn't like it if $& is earlier than where we asked it to
* start searching (which can happen on something like /.\G/) */
if ( (flags & REXEC_FAIL_ON_UNDERFLOW)
if (RXp_PAREN_NAMES(prog))
(void)hv_iterinit(RXp_PAREN_NAMES(prog));
- RX_MATCH_UTF8_set(rx, utf8_target);
-
/* make sure $`, $&, $', and $digit will work later */
if ( !(flags & REXEC_NOT_FIRST) )
S_reg_set_capture_string(aTHX_ rx,
return 1;
-phooey:
+ phooey:
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
PL_colors[4], PL_colors[5]));
STATIC I32 /* 0 failure, 1 success */
S_regtry(pTHX_ regmatch_info *reginfo, char **startposp)
{
- dVAR;
CHECKPOINT lastcp;
REGEXP *const rx = reginfo->prog;
regexp *const prog = ReANY(rx);
* or 0 if non of the buffers matched.
*/
STATIC I32
-S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan)
+S_reg_check_named_buff_matched(const regexp *rex, const regnode *scan)
{
I32 n;
RXi_GET_DECL(rex,rexi);
const bool utf8_target = reginfo->is_utf8_target;
- UV c1 = CHRTEST_NOT_A_CP_1;
- UV c2 = CHRTEST_NOT_A_CP_2;
+ UV c1 = (UV)CHRTEST_NOT_A_CP_1;
+ UV c2 = (UV)CHRTEST_NOT_A_CP_2;
bool use_chrtest_void = FALSE;
const bool is_utf8_pat = reginfo->is_utf8_pat;
U8 *pat = (U8*)STRING(text_node);
U8 folded[UTF8_MAX_FOLD_CHAR_EXPAND * UTF8_MAXBYTES_CASE + 1] = { '\0' };
- if (OP(text_node) == EXACT) {
+ if (OP(text_node) == EXACT || OP(text_node) == EXACTL) {
/* In an exact node, only one thing can be matched, that first
* character. If both the pat and the target are UTF-8, we can just
}
else { /* an EXACTFish node which doesn't begin with a multi-char fold */
c1 = is_utf8_pat ? valid_utf8_to_uvchr(pat, NULL) : *pat;
- if (c1 > 256) {
+ if (c1 > 255) {
/* Load the folds hash, if not already done */
SV** listp;
if (! PL_utf8_foldclosures) {
- if (! PL_utf8_tofold) {
- U8 dummy[UTF8_MAXBYTES_CASE+1];
-
- /* Force loading this by folding an above-Latin1 char */
- to_utf8_fold((U8*) HYPHEN_UTF8, dummy, NULL);
- assert(PL_utf8_tofold); /* Verify that worked */
- }
- PL_utf8_foldclosures = _swash_inversion_hash(PL_utf8_tofold);
+ _load_PL_utf8_foldclosures();
}
/* The fold closures data structure is a hash with the keys
/* Folds that cross the 255/256 boundary are forbidden
* if EXACTFL (and isnt a UTF8 locale), or EXACTFA and
* one is ASCIII. Since the pattern character is above
- * 256, and its only other match is below 256, the only
+ * 255, and its only other match is below 256, the only
* legal match will be to itself. We have thrown away
* the original, so have to compute which is the one
- * above 255 */
+ * above 255. */
if ((c1 < 256) != (c2 < 256)) {
if ((OP(text_node) == EXACTFL
&& ! IN_UTF8_CTYPE_LOCALE)
}
}
}
- else /* Here, c1 is < 255 */
+ else /* Here, c1 is <= 255 */
if (utf8_target
&& HAS_NONLATIN1_FOLD_CLOSURE(c1)
&& ( ! (OP(text_node) == EXACTFL && ! IN_UTF8_CTYPE_LOCALE))
case EXACTFA_NO_TRIE: /* This node only generated for
non-utf8 patterns */
assert(! is_utf8_pat);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case EXACTFA:
case EXACTFU_SS:
case EXACTFU:
default:
Perl_croak(aTHX_ "panic: Unexpected op %u", OP(text_node));
- assert(0); /* NOTREACHED */
+ NOT_REACHED; /* NOTREACHED */
}
}
}
SV * const prop = sv_newmortal();
regnode *rnext=regnext(scan);
DUMP_EXEC_POS( locinput, scan, utf8_target );
- regprop(rex, prop, scan, reginfo);
+ regprop(rex, prop, scan, reginfo, NULL);
PerlIO_printf(Perl_debug_log,
"%3"IVdf":%*s%s(%"IVdf")\n",
assert(nextchr < 256 && (nextchr >= 0 || nextchr == NEXTCHR_EOS));
switch (state_num) {
- case BOL: /* /^../ */
- case SBOL: /* /^../s */
+ case SBOL: /* /^../ and /\A../ */
if (locinput == reginfo->strbeg)
break;
sayNO;
st->u.keeper.val = rex->offs[0].start;
rex->offs[0].start = locinput - reginfo->strbeg;
PUSH_STATE_GOTO(KEEPS_next, next, locinput);
- assert(0); /*NOTREACHED*/
+ /* NOTREACHED */
+ NOT_REACHED;
+
case KEEPS_next_fail:
/* rollback the start point change */
rex->offs[0].start = st->u.keeper.val;
sayNO_SILENT;
- assert(0); /*NOTREACHED*/
+ /* NOTREACHED */
+ NOT_REACHED;
case MEOL: /* /..$/m */
if (!NEXTCHR_IS_EOS && nextchr != '\n')
sayNO;
break;
- case EOL: /* /..$/ */
- /* FALL THROUGH */
- case SEOL: /* /..$/s */
+ case SEOL: /* /..$/ */
if (!NEXTCHR_IS_EOS && nextchr != '\n')
sayNO;
if (reginfo->strend - locinput > 1)
REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
);
sayNO_SILENT;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case TRIE: /* (ab|cd) */
/* the basic plan of execution of the trie is:
* At the beginning, run though all the states, and
HV * widecharmap = MUTABLE_HV(rexi->data->data[ ARG( scan ) + 1 ]);
U32 state = trie->startstate;
+ if (scan->flags == EXACTL || scan->flags == EXACTFLU8) {
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ if (utf8_target
+ && UTF8_IS_ABOVE_LATIN1(nextchr)
+ && scan->flags == EXACTL)
+ {
+ /* We only output for EXACTL, as we let the folder
+ * output this message for EXACTFLU8 to avoid
+ * duplication */
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput,
+ reginfo->strend);
+ }
+ }
if ( trie->bitmap
&& (NEXTCHR_IS_EOS || !TRIE_BITMAP_TEST(trie, nextchr)))
{
);
goto trie_first_try; /* jump into the fail handler */
}}
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case TRIE_next_fail: /* we failed - try next alternative */
{
if (ST.accepted > 1 || has_cutgroup) {
PUSH_STATE_GOTO(TRIE_next, scan, (char*)uc);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
/* only one choice left - just continue */
DEBUG_EXECUTE_r({
locinput = (char*)uc;
continue; /* execute rest of RE */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
}
#undef ST
+ case EXACTL: /* /abc/l */
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+
+ /* Complete checking would involve going through every character
+ * matched by the string to see if any is above latin1. But the
+ * comparision otherwise might very well be a fast assembly
+ * language routine, and I (khw) don't think slowing things down
+ * just to check for this warning is worth it. So this just checks
+ * the first character */
+ if (utf8_target && UTF8_IS_ABOVE_LATIN1(*locinput)) {
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput, reginfo->strend);
+ }
+ /* FALLTHROUGH */
case EXACT: { /* /abc/ */
char *s = STRING(scan);
ln = STR_LEN(scan);
const char * s;
U32 fold_utf8_flags;
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
folder = foldEQ_locale;
fold_array = PL_fold_locale;
fold_utf8_flags = FOLDEQ_LOCALE;
goto do_exactf;
+ case EXACTFLU8: /* /abc/il; but all 'abc' are above 255, so
+ is effectively /u; hence to match, target
+ must be UTF-8. */
+ if (! utf8_target) {
+ sayNO;
+ }
+ fold_utf8_flags = FOLDEQ_LOCALE | FOLDEQ_S1_ALREADY_FOLDED
+ | FOLDEQ_S1_FOLDS_SANE;
+ folder = foldEQ_latin1;
+ fold_array = PL_fold_latin1;
+ goto do_exactf;
+
case EXACTFU_SS: /* /\x{df}/iu */
case EXACTFU: /* /abc/iu */
folder = foldEQ_latin1;
case EXACTFA_NO_TRIE: /* This node only generated for non-utf8
patterns */
assert(! is_utf8_pat);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case EXACTFA: /* /abc/iaa */
folder = foldEQ_latin1;
fold_array = PL_fold_latin1;
break;
}
- /* XXX Could improve efficiency by separating these all out using a
- * macro or in-line function. At that point regcomp.c would no longer
- * have to set the FLAGS fields of these */
- case BOUNDL: /* /\b/l */
+ /* XXX At that point regcomp.c would no longer * have to set the FLAGS fields of these */
case NBOUNDL: /* /\B/l */
+ to_complement = 1;
+ /* FALLTHROUGH */
+
+ case BOUNDL: /* /\b/l */
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ if (utf8_target) {
+ if (locinput == reginfo->strbeg)
+ ln = isWORDCHAR_LC('\n');
+ else {
+ ln = isWORDCHAR_LC_utf8(reghop3((U8*)locinput, -1,
+ (U8*)(reginfo->strbeg)));
+ }
+ n = (NEXTCHR_IS_EOS)
+ ? isWORDCHAR_LC('\n')
+ : isWORDCHAR_LC_utf8((U8*)locinput);
+ }
+ else { /* Here the string isn't utf8 */
+ ln = (locinput == reginfo->strbeg)
+ ? isWORDCHAR_LC('\n')
+ : isWORDCHAR_LC(UCHARAT(locinput - 1));
+ n = (NEXTCHR_IS_EOS)
+ ? isWORDCHAR_LC('\n')
+ : isWORDCHAR_LC(nextchr);
+ }
+ if (to_complement ^ (ln == n)) {
+ sayNO;
+ }
+ break;
+
+ case NBOUND: /* /\B/ */
+ to_complement = 1;
+ /* FALLTHROUGH */
+
case BOUND: /* /\b/ */
- case BOUNDU: /* /\b/u */
+ if (utf8_target) {
+ goto bound_utf8;
+ }
+ goto bound_ascii_match_only;
+
+ case NBOUNDA: /* /\B/a */
+ to_complement = 1;
+ /* FALLTHROUGH */
+
case BOUNDA: /* /\b/a */
- case NBOUND: /* /\B/ */
+
+ bound_ascii_match_only:
+ /* Here the string isn't utf8, or is utf8 and only ascii characters
+ * are to match \w. In the latter case looking at the byte just
+ * prior to the current one may be just the final byte of a
+ * multi-byte character. This is ok. There are two cases:
+ * 1) it is a single byte character, and then the test is doing
+ * just what it's supposed to.
+ * 2) it is a multi-byte character, in which case the final byte is
+ * never mistakable for ASCII, and so the test will say it is
+ * not a word character, which is the correct answer. */
+ ln = (locinput == reginfo->strbeg)
+ ? isWORDCHAR_A('\n')
+ : isWORDCHAR_A(UCHARAT(locinput - 1));
+ n = (NEXTCHR_IS_EOS)
+ ? isWORDCHAR_A('\n')
+ : isWORDCHAR_A(nextchr);
+ if (to_complement ^ (ln == n)) {
+ sayNO;
+ }
+ break;
+
case NBOUNDU: /* /\B/u */
- case NBOUNDA: /* /\B/a */
- /* was last char in word? */
- if (utf8_target
- && FLAGS(scan) != REGEX_ASCII_RESTRICTED_CHARSET
- && FLAGS(scan) != REGEX_ASCII_MORE_RESTRICTED_CHARSET)
- {
- if (locinput == reginfo->strbeg)
- ln = '\n';
- else {
- const U8 * const r =
- reghop3((U8*)locinput, -1, (U8*)(reginfo->strbeg));
+ to_complement = 1;
+ /* FALLTHROUGH */
- ln = utf8n_to_uvchr(r, (U8*) reginfo->strend - r,
- 0, uniflags);
- }
- if (FLAGS(scan) != REGEX_LOCALE_CHARSET) {
- ln = isWORDCHAR_uni(ln);
- if (NEXTCHR_IS_EOS)
- n = 0;
- else {
- LOAD_UTF8_CHARCLASS_ALNUM();
- n = swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)locinput,
- utf8_target);
- }
- }
- else {
- ln = isWORDCHAR_LC_uvchr(ln);
- n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_LC_utf8((U8*)locinput);
- }
+ case BOUNDU: /* /\b/u */
+ if (utf8_target) {
+
+ bound_utf8:
+ ln = (locinput == reginfo->strbeg)
+ ? isWORDCHAR_L1('\n')
+ : isWORDCHAR_utf8(reghop3((U8*)locinput, -1,
+ (U8*)(reginfo->strbeg)));
+ n = (NEXTCHR_IS_EOS)
+ ? isWORDCHAR_L1('\n')
+ : isWORDCHAR_utf8((U8*)locinput);
}
else {
+ ln = (locinput == reginfo->strbeg)
+ ? isWORDCHAR_L1('\n')
+ : isWORDCHAR_L1(UCHARAT(locinput - 1));
+ n = (NEXTCHR_IS_EOS)
+ ? isWORDCHAR_L1('\n')
+ : isWORDCHAR_L1(nextchr);
- /* Here the string isn't utf8, or is utf8 and only ascii
- * characters are to match \w. In the latter case looking at
- * the byte just prior to the current one may be just the final
- * byte of a multi-byte character. This is ok. There are two
- * cases:
- * 1) it is a single byte character, and then the test is doing
- * just what it's supposed to.
- * 2) it is a multi-byte character, in which case the final
- * byte is never mistakable for ASCII, and so the test
- * will say it is not a word character, which is the
- * correct answer. */
- ln = (locinput != reginfo->strbeg) ?
- UCHARAT(locinput - 1) : '\n';
- switch (FLAGS(scan)) {
- case REGEX_UNICODE_CHARSET:
- ln = isWORDCHAR_L1(ln);
- n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_L1(nextchr);
- break;
- case REGEX_LOCALE_CHARSET:
- ln = isWORDCHAR_LC(ln);
- n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_LC(nextchr);
- break;
- case REGEX_DEPENDS_CHARSET:
- ln = isWORDCHAR(ln);
- n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR(nextchr);
- break;
- case REGEX_ASCII_RESTRICTED_CHARSET:
- case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
- ln = isWORDCHAR_A(ln);
- n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_A(nextchr);
- break;
- default:
- Perl_croak(aTHX_ "panic: Unexpected FLAGS %u in op %u", FLAGS(scan), OP(scan));
- break;
- }
}
- /* Note requires that all BOUNDs be lower than all NBOUNDs in
- * regcomp.sym */
- if (((!ln) == (!n)) == (OP(scan) < NBOUND))
- sayNO;
+
+ if (to_complement ^ (ln == n)) {
+ sayNO;
+ }
break;
- case ANYOF: /* /[abc]/ */
+ case ANYOFL: /* /[abc]/l */
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ /* FALLTHROUGH */
+ case ANYOF: /* /[abc]/ */
if (NEXTCHR_IS_EOS)
sayNO;
if (utf8_target) {
/* FALLTHROUGH */
case POSIXL: /* \w or [:punct:] etc. under /l */
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
if (NEXTCHR_IS_EOS)
sayNO;
}
}
else { /* Here, must be an above Latin-1 code point */
- goto utf8_posix_not_eos;
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput, reginfo->strend);
+ goto utf8_posix_above_latin1;
}
/* Here, must be utf8 */
if (NEXTCHR_IS_EOS) {
sayNO;
}
- utf8_posix_not_eos:
/* Use _generic_isCC() for characters within Latin1. (Note that
* UTF8_IS_INVARIANT works even on non-UTF-8 strings, or else
locinput += 2;
}
else { /* Handle above Latin-1 code points */
+ utf8_posix_above_latin1:
classnum = (_char_class_number) FLAGS(scan);
if (classnum < _FIRST_NON_SWASH_CC) {
const U8 *fold_array;
UV utf8_fold_flags;
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
folder = foldEQ_locale;
fold_array = PL_fold_locale;
type = REFFL;
goto do_nref_ref_common;
case REFFL: /* /\1/il */
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
folder = foldEQ_locale;
fold_array = PL_fold_locale;
utf8_fold_flags = FOLDEQ_LOCALE;
case TAIL: /* placeholder while compiling (A|B|C) */
break;
- case BACK: /* ??? doesn't appear to be used ??? */
- break;
-
#undef ST
#define ST st->u.eval
{
/* and then jump to the code we share with EVAL */
goto eval_recurse_doit;
-
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */
if (cur_eval && cur_eval->locinput==locinput) {
assert(o->op_targ == OP_LEAVE);
o = cUNOPo->op_first;
assert(o->op_type == OP_ENTER);
- o = o->op_sibling;
+ o = OpSIBLING(o);
}
if (o->op_type != OP_STUB) {
assert(!(scan->flags & ~RXf_PMf_COMPILETIME));
re_sv = rex->engine->op_comp(aTHX_ &ret, 1, NULL,
rex->engine, NULL, NULL,
- /* copy /msix etc to inner pattern */
- scan->flags,
+ /* copy /msixn etc to inner pattern */
+ ARG2L(scan),
pm_flags);
if (!(SvFLAGS(ret)
cur_eval = st;
/* now continue from first node in postoned RE */
PUSH_YES_STATE_GOTO(EVAL_AB, startpoint, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
case EVAL_AB: /* cleanup after a successful (??{A})B */
}
}
goto fake_end;
- /*NOTREACHED*/
+ /* NOTREACHED */
case GROUPP: /* (?(1)) */
n = ARG(scan); /* which paren pair */
ST.lastloc = NULL; /* this will be updated by WHILEM */
PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next), locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
case CURLYX_end: /* just finished matching all of A*B */
cur_curlyx = ST.prev_curlyx;
sayYES;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case CURLYX_end_fail: /* just failed to match all of A*B */
regcpblow(ST.cp);
cur_curlyx = ST.prev_curlyx;
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
#undef ST
{
/* see the discussion above about CURLYX/WHILEM */
I32 n;
- int min = ARG1(cur_curlyx->u.curlyx.me);
- int max = ARG2(cur_curlyx->u.curlyx.me);
- regnode *A = NEXTOPER(cur_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS;
+ int min, max;
+ regnode *A;
assert(cur_curlyx); /* keep Coverity happy */
+
+ min = ARG1(cur_curlyx->u.curlyx.me);
+ max = ARG2(cur_curlyx->u.curlyx.me);
+ A = NEXTOPER(cur_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS;
n = ++cur_curlyx->u.curlyx.count; /* how many A's matched */
ST.save_lastloc = cur_curlyx->u.curlyx.lastloc;
ST.cache_offset = 0;
REGCP_SET(ST.lastcp);
PUSH_STATE_GOTO(WHILEM_A_pre, A, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
/* If degenerate A matches "", assume A done. */
REGCP_SET(ST.lastcp);
PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B,
locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
/* Prefer A over B for maximal matching. */
cur_curlyx->u.curlyx.lastloc = locinput;
REGCP_SET(ST.lastcp);
PUSH_STATE_GOTO(WHILEM_A_max, A, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
goto do_whilem_B_max;
}
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case WHILEM_B_min: /* just matched B in a minimal match */
case WHILEM_B_max: /* just matched B in a maximal match */
cur_curlyx = ST.save_curlyx;
sayYES;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case WHILEM_B_max_fail: /* just failed to match B in a maximal match */
cur_curlyx = ST.save_curlyx;
cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
cur_curlyx->u.curlyx.count--;
CACHEsayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case WHILEM_A_pre_fail: /* just failed to match even minimal A */
REGCP_UNWIND(ST.lastcp);
regcppop(rex, &maxopenparen);
cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
cur_curlyx->u.curlyx.count--;
CACHEsayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
REGCP_UNWIND(ST.lastcp);
cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B,
locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
cur_curlyx = ST.save_curlyx;
PUSH_STATE_GOTO(WHILEM_A_min,
/*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS,
locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
#undef ST
#define ST st->u.branch
if (next == scan)
next = NULL;
scan = NEXTOPER(scan);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case BRANCH: /* /(...|A|...)/ */
scan = NEXTOPER(scan); /* scan now points to inner node */
} else {
PUSH_STATE_GOTO(BRANCH_next, scan, locinput);
}
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case CUTGROUP: /* /(*THEN)/ */
sv_yes_mark = st->u.mark.mark_name = scan->flags ? NULL :
MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
PUSH_STATE_GOTO(CUTGROUP_next, next, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case CUTGROUP_next_fail:
do_cutgroup = 1;
if (st->u.mark.mark_name)
sv_commit = st->u.mark.mark_name;
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case BRANCH_next:
sayYES;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case BRANCH_next_fail: /* that branch failed; try the next, if any */
if (do_cutgroup) {
sayNO_SILENT;
}
continue; /* execute next BRANCH[J] op */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
case MINMOD: /* next op will be non-greedy, e.g. A*? */
minmod = 1;
curlym_do_A: /* execute the A in /A{m,n}B/ */
PUSH_YES_STATE_GOTO(CURLYM_A, ST.A, locinput); /* match A */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case CURLYM_A: /* we've just matched an A */
ST.count++;
/* calculate c1 and c2 for possible match of 1st char
* following curly */
ST.c1 = ST.c2 = CHRTEST_VOID;
+ assert(ST.B);
if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) {
regnode *text_node = ST.B;
if (! HAS_TEXT(text_node))
}
PUSH_STATE_GOTO(CURLYM_B, ST.B, locinput); /* match B */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case CURLYM_B_fail: /* just failed to match a B */
REGCP_UNWIND(ST.cp);
REGCP_SET(ST.cp);
goto curly_try_B_max;
}
- assert(0); /* NOTREACHED */
-
+ /* NOTREACHED */
+ NOT_REACHED;
case CURLY_B_min_known_fail:
/* failed to find B in a non-greedy match where c1,c2 valid */
}
PUSH_STATE_GOTO(CURLY_B_min_known, ST.B, locinput);
}
- assert(0); /* NOTREACHED */
-
+ /* NOTREACHED */
+ NOT_REACHED;
case CURLY_B_min_fail:
/* failed to find B in a non-greedy match where c1,c2 invalid */
}
}
sayNO;
- assert(0); /* NOTREACHED */
-
+ /* NOTREACHED */
+ NOT_REACHED;
curly_try_B_max:
/* a successful greedy match: now try to match B */
if (ST.c1 == CHRTEST_VOID || could_match) {
CURLY_SETPAREN(ST.paren, ST.count);
PUSH_STATE_GOTO(CURLY_B_max, ST.B, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case CURLY_B_max_fail:
/* failed to find B in a greedy match */
/* execute body of (?...A) */
PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)), newstart);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
case IFMATCH_A_fail: /* body of (?...A) failed */
ST.wanted = !ST.wanted;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case IFMATCH_A: /* body of (?...A) succeeded */
if (ST.logical) {
if (!scan->flags)
sv_yes_mark = sv_commit = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
PUSH_STATE_GOTO(COMMIT_next, next, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case COMMIT_next_fail:
no_final = 1;
case OPFAIL: /* (*FAIL) */
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
#define ST st->u.mark
case MARKPOINT: /* (*MARK:foo) */
mark_state = st;
ST.mark_loc = locinput;
PUSH_YES_STATE_GOTO(MARKPOINT_next, next, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case MARKPOINT_next:
mark_state = ST.prev_mark;
sayYES;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case MARKPOINT_next_fail:
if (popmark && sv_eq(ST.mark_name,popmark))
sv_yes_mark = mark_state ?
mark_state->u.mark.mark_name : NULL;
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
case SKIP: /* (*SKIP) */
if (scan->flags) {
}
no_final = 1;
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
#undef ST
case LNBREAK: /* \R */
/* switch break jumps here */
scan = next; /* prepare to execute the next op and ... */
continue; /* ... jump back to the top, reusing st */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
push_yes_state:
/* push a state that backtracks on success */
st->u.yes.prev_yes_state = yes_state;
yes_state = st;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
push_state:
/* push a new regex state, then continue at scan */
{
locinput = pushinput;
st = newst;
continue;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
}
}
* the terminating point.
*/
Perl_croak(aTHX_ "corrupted regexp pointers");
- /*NOTREACHED*/
+ /* NOTREACHED */
sayNO;
+ NOT_REACHED;
-yes:
+ yes:
if (yes_state) {
/* we have successfully completed a subexpression, but we must now
* pop to the state marked by yes_state and continue from there */
result = 1;
goto final_exit;
-no:
+ no:
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s %sfailed...%s\n",
PL_colors[4], PL_colors[5])
);
-no_silent:
+ no_silent:
if (no_final) {
if (yes_state) {
goto yes;
sv_commit = &PL_sv_yes;
sv_yes_mark = &PL_sv_no;
}
+ assert(sv_err);
+ assert(sv_mrk);
sv_setsv(sv_err, sv_commit);
sv_setsv(sv_mrk, sv_yes_mark);
}
S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
regmatch_info *const reginfo, I32 max, int depth)
{
- dVAR;
char *scan; /* Pointer to current position in target string */
I32 c;
char *loceol = reginfo->strend; /* local version */
scan = loceol;
}
break;
+ case EXACTL:
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ if (utf8_target && UTF8_IS_ABOVE_LATIN1(*scan)) {
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(scan, loceol);
+ }
+ /* FALLTHROUGH */
case EXACT:
assert(STR_LEN(p) == reginfo->is_utf8_pat ? UTF8SKIP(STRING(p)) : 1);
case EXACTFA_NO_TRIE: /* This node only generated for non-utf8 patterns */
assert(! reginfo->is_utf8_pat);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case EXACTFA:
utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII;
goto do_exactf;
case EXACTFL:
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
utf8_flags = FOLDEQ_LOCALE;
goto do_exactf;
utf8_flags = 0;
goto do_exactf;
+ case EXACTFLU8:
+ if (! utf8_target) {
+ break;
+ }
+ utf8_flags = FOLDEQ_LOCALE | FOLDEQ_S2_ALREADY_FOLDED
+ | FOLDEQ_S2_FOLDS_SANE;
+ goto do_exactf;
+
case EXACTFU_SS:
case EXACTFU:
utf8_flags = reginfo->is_utf8_pat ? FOLDEQ_S2_ALREADY_FOLDED : 0;
}
break;
}
+ case ANYOFL:
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ /* FALLTHROUGH */
case ANYOF:
if (utf8_target) {
while (hardcount < max
/* FALLTHROUGH */
case POSIXL:
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
if (! utf8_target) {
while (scan < loceol && to_complement ^ cBOOL(isFOO_lc(FLAGS(p),
*scan)))
to_complement = 1;
goto utf8_posix;
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case NPOSIXA:
if (! utf8_target) {
else {
/* The complement of something that matches only ASCII matches all
- * UTF-8 variant code points, plus everything in ASCII that isn't
- * in the class. */
+ * non-ASCII, plus everything in ASCII that isn't in the class. */
while (hardcount < max && scan < loceol
- && (! UTF8_IS_INVARIANT(*scan)
+ && (! isASCII_utf8(scan)
|| ! _generic_isCC_A((U8) *scan, FLAGS(p))))
{
scan += UTF8SKIP(scan);
case _CC_ENUM_SPACE: /* XXX would require separate code
if we revert the change of \v
matching this */
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case _CC_ENUM_PSXSPC:
while (hardcount < max
&& scan < loceol
}
break;
+ case BOUNDL:
+ case NBOUNDL:
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ /* FALLTHROUGH */
case BOUND:
case BOUNDA:
- case BOUNDL:
case BOUNDU:
case EOS:
case GPOS:
case KEEPS:
case NBOUND:
case NBOUNDA:
- case NBOUNDL:
case NBOUNDU:
case OPFAIL:
case SBOL:
default:
Perl_croak(aTHX_ "panic: regrepeat() called with unrecognized node type %d='%s'", OP(p), PL_reg_name[OP(p)]);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ NOT_REACHED;
}
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_EXECUTE_r({
SV * const prop = sv_newmortal();
- regprop(prog, prop, p, reginfo);
+ regprop(prog, prop, p, reginfo, NULL);
PerlIO_printf(Perl_debug_log,
"%*s %s can match %"IVdf" times out of %"IVdf"...\n",
REPORT_CODE_OFF + depth*2, "", SvPVX_const(prop),(IV)c,(IV)max);
*altsvp = NULL;
}
- return newSVsv(_get_regclass_nonbitmap_data(prog, node, doinit, listsvp, NULL));
+ return newSVsv(_get_regclass_nonbitmap_data(prog, node, doinit, listsvp, NULL, NULL));
}
-SV *
-Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog,
- const regnode* node,
- bool doinit,
- SV** listsvp,
- SV** only_utf8_locale_ptr)
-{
- /* For internal core use only.
- * Returns the swash for the input 'node' in the regex 'prog'.
- * If <doinit> is 'true', will attempt to create the swash if not already
- * done.
- * If <listsvp> is non-null, will return the printable contents of the
- * swash. This can be used to get debugging information even before the
- * swash exists, by calling this function with 'doinit' set to false, in
- * which case the components that will be used to eventually create the
- * swash are returned (in a printable form).
- * Tied intimately to how regcomp.c sets up the data structure */
-
- dVAR;
- SV *sw = NULL;
- SV *si = NULL; /* Input swash initialization string */
- SV* invlist = NULL;
-
- RXi_GET_DECL(prog,progi);
- const struct reg_data * const data = prog ? progi->data : NULL;
-
- PERL_ARGS_ASSERT__GET_REGCLASS_NONBITMAP_DATA;
-
- assert(ANYOF_FLAGS(node)
- & (ANYOF_UTF8|ANYOF_NONBITMAP_NON_UTF8|ANYOF_LOC_FOLD));
-
- if (data && data->count) {
- const U32 n = ARG(node);
-
- if (data->what[n] == 's') {
- SV * const rv = MUTABLE_SV(data->data[n]);
- AV * const av = MUTABLE_AV(SvRV(rv));
- SV **const ary = AvARRAY(av);
- U8 swash_init_flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
-
- si = *ary; /* ary[0] = the string to initialize the swash with */
-
- /* Elements 3 and 4 are either both present or both absent. [3] is
- * any inversion list generated at compile time; [4] indicates if
- * that inversion list has any user-defined properties in it. */
- if (av_tindex(av) >= 2) {
- if (only_utf8_locale_ptr
- && ary[2]
- && ary[2] != &PL_sv_undef)
- {
- *only_utf8_locale_ptr = ary[2];
- }
- else {
- *only_utf8_locale_ptr = NULL;
- }
-
- if (av_tindex(av) >= 3) {
- invlist = ary[3];
- if (SvUV(ary[4])) {
- swash_init_flags |= _CORE_SWASH_INIT_USER_DEFINED_PROPERTY;
- }
- }
- else {
- invlist = NULL;
- }
- }
-
- /* Element [1] is reserved for the set-up swash. If already there,
- * return it; if not, create it and store it there */
- if (ary[1] && SvROK(ary[1])) {
- sw = ary[1];
- }
- else if (doinit && ((si && si != &PL_sv_undef)
- || (invlist && invlist != &PL_sv_undef))) {
-
- sw = _core_swash_init("utf8", /* the utf8 package */
- "", /* nameless */
- si,
- 1, /* binary */
- 0, /* not from tr/// */
- invlist,
- &swash_init_flags);
- (void)av_store(av, 1, sw);
- }
- }
- }
-
- /* If requested, return a printable version of what this swash matches */
- if (listsvp) {
- SV* matches_string = newSVpvn("", 0);
-
- /* The swash should be used, if possible, to get the data, as it
- * contains the resolved data. But this function can be called at
- * compile-time, before everything gets resolved, in which case we
- * return the currently best available information, which is the string
- * that will eventually be used to do that resolving, 'si' */
- if ((! sw || (invlist = _get_swash_invlist(sw)) == NULL)
- && (si && si != &PL_sv_undef))
- {
- sv_catsv(matches_string, si);
- }
-
- /* Add the inversion list to whatever we have. This may have come from
- * the swash, or from an input parameter */
- if (invlist) {
- sv_catsv(matches_string, _invlist_contents(invlist));
- }
- *listsvp = matches_string;
- }
-
- return sw;
-}
#endif /* !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION) */
/*
- reginclass - determine if a character falls into a character class
- n is the ANYOF regnode
+ n is the ANYOF-type regnode
p is the target string
p_end points to one byte beyond the end of the target string
utf8_target tells whether p is in UTF-8.
* UTF8_ALLOW_FFFF */
if (c_len == (STRLEN)-1)
Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
+ if (c > 255 && OP(n) == ANYOFL && ! is_ANYOF_SYNTHETIC(n)) {
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(c);
+ }
}
/* If this character is potentially in the bitmap, check it */
- if (c < 256) {
+ if (c < NUM_ANYOF_CODE_POINTS) {
if (ANYOF_BITMAP_TEST(n, c))
match = TRUE;
- else if (flags & ANYOF_NON_UTF8_NON_ASCII_ALL
- && ! utf8_target
- && ! isASCII(c))
+ else if ((flags & ANYOF_MATCHES_ALL_NON_UTF8_NON_ASCII)
+ && ! utf8_target
+ && ! isASCII(c))
{
match = TRUE;
}
else if (flags & ANYOF_LOCALE_FLAGS) {
- if (flags & ANYOF_LOC_FOLD) {
- if (ANYOF_BITMAP_TEST(n, PL_fold_locale[c])) {
- match = TRUE;
- }
+ if ((flags & ANYOF_LOC_FOLD)
+ && c < 256
+ && ANYOF_BITMAP_TEST(n, PL_fold_locale[c]))
+ {
+ match = TRUE;
}
- if (! match && ANYOF_POSIXL_TEST_ANY_SET(n)) {
+ else if (ANYOF_POSIXL_TEST_ANY_SET(n)
+ && c < 256
+ ) {
/* The data structure is arranged so bits 0, 2, 4, ... are set
* if the class includes the Posix character class given by
/* If the bitmap didn't (or couldn't) match, and something outside the
* bitmap could match, try that. */
if (!match) {
- if (c >= 256 && (flags & ANYOF_ABOVE_LATIN1_ALL)) {
- match = TRUE; /* Everything above 255 matches */
+ if (c >= NUM_ANYOF_CODE_POINTS
+ && (flags & ANYOF_MATCHES_ALL_ABOVE_BITMAP))
+ {
+ match = TRUE; /* Everything above the bitmap matches */
}
- else if ((flags & ANYOF_NONBITMAP_NON_UTF8)
- || (utf8_target && (flags & ANYOF_UTF8))
+ else if ((flags & ANYOF_HAS_NONBITMAP_NON_UTF8_MATCHES)
+ || (utf8_target && (flags & ANYOF_HAS_UTF8_NONBITMAP_MATCHES))
|| ((flags & ANYOF_LOC_FOLD)
&& IN_UTF8_CTYPE_LOCALE
- && ARG(n) != ANYOF_NONBITMAP_EMPTY))
+ && ARG(n) != ANYOF_ONLY_HAS_BITMAP))
{
SV* only_utf8_locale = NULL;
SV * const sw = _get_regclass_nonbitmap_data(prog, n, TRUE, 0,
- &only_utf8_locale);
+ &only_utf8_locale, NULL);
if (sw) {
+ U8 utf8_buffer[2];
U8 * utf8_p;
if (utf8_target) {
utf8_p = (U8 *) p;
} else { /* Convert to utf8 */
- STRLEN len = 1;
- utf8_p = bytes_to_utf8(p, &len);
+ utf8_p = utf8_buffer;
+ append_utf8_from_native_byte(*p, &utf8_p);
+ utf8_p = utf8_buffer;
}
if (swash_fetch(sw, utf8_p, TRUE)) {
match = TRUE;
}
-
- /* If we allocated a string above, free it */
- if (! utf8_target) Safefree(utf8_p);
}
if (! match && only_utf8_locale && IN_UTF8_CTYPE_LOCALE) {
match = _invlist_contains_cp(only_utf8_locale, c);
* 'off' >= 0, backwards if negative. But don't go outside of position
* 'lim', which better be < s if off < 0 */
- dVAR;
-
PERL_ARGS_ASSERT_REGHOP3;
if (off >= 0) {
STATIC U8 *
S_reghop4(U8 *s, SSize_t off, const U8* llim, const U8* rlim)
{
- dVAR;
-
PERL_ARGS_ASSERT_REGHOP4;
if (off >= 0) {
return s;
}
+/* like reghop3, but returns NULL on overrun, rather than returning last
+ * char pos */
+
STATIC U8 *
S_reghopmaybe3(U8* s, SSize_t off, const U8* lim)
{
- dVAR;
-
PERL_ARGS_ASSERT_REGHOPMAYBE3;
if (off >= 0) {
static void
S_cleanup_regmatch_info_aux(pTHX_ void *arg)
{
- dVAR;
regmatch_info_aux *aux = (regmatch_info_aux *) arg;
regmatch_info_aux_eval *eval_state = aux->info_aux_eval;
regmatch_slab *s;
/* Converts substr fields in prog from UTF-8 to bytes, calling fbm_compile
* on the converted value; returns FALSE if can't be converted. */
- dVAR;
int i = 1;
PERL_ARGS_ASSERT_TO_BYTE_SUBSTR;
https://perl5.git.perl.org / perl5.git / blobdiff