#define REG_COMP_C
#ifdef PERL_IN_XSUB_RE
# include "re_comp.h"
-extern const struct regexp_engine my_reg_engine;
+EXTERN_C const struct regexp_engine my_reg_engine;
#else
# include "regcomp.h"
#endif
#include "inline_invlist.c"
#include "unicode_constants.h"
-#define HAS_NONLATIN1_FOLD_CLOSURE(i) _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
+#define HAS_NONLATIN1_FOLD_CLOSURE(i) \
+ _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
#define IS_NON_FINAL_FOLD(c) _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
#define IS_IN_SOME_FOLD_L1(c) _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
char *precomp; /* uncompiled string. */
REGEXP *rx_sv; /* The SV that is the regexp. */
regexp *rx; /* perl core regexp structure */
- regexp_internal *rxi; /* internal data for regexp object pprivate field */
+ regexp_internal *rxi; /* internal data for regexp object
+ pprivate field */
char *start; /* Start of input for compile */
char *end; /* End of input for compile */
char *parse; /* Input-scan pointer. */
SSize_t whilem_seen; /* number of WHILEM in this expr */
regnode *emit_start; /* Start of emitted-code area */
- regnode *emit_bound; /* First regnode outside of the allocated space */
+ regnode *emit_bound; /* First regnode outside of the
+ allocated space */
regnode *emit; /* Code-emit pointer; if = &emit_dummy,
implies compiling, so don't emit */
regnode_ssc emit_dummy; /* placeholder for emit to point to;
I32 sawback; /* Did we see \1, ...? */
U32 seen;
SSize_t size; /* Code size. */
- I32 npar; /* Capture buffer count, (OPEN). */
- I32 cpar; /* Capture buffer count, (CLOSE). */
- I32 nestroot; /* root parens we are in - used by accept */
+ I32 npar; /* Capture buffer count, (OPEN) plus
+ one. ("par" 0 is the whole
+ pattern)*/
+ I32 nestroot; /* root parens we are in - used by
+ accept */
I32 extralen;
I32 seen_zerolen;
regnode **open_parens; /* pointers to open parens */
rules, even if the pattern is not in
utf8 */
HV *paren_names; /* Paren names */
-
+
regnode **recurse; /* Recurse regops */
I32 recurse_count; /* Number of recurse regops */
+ U8 *study_chunk_recursed; /* bitmap of which parens we have moved
+ through */
+ U32 study_chunk_recursed_bytes; /* bytes in bitmap */
I32 in_lookbehind;
I32 contains_locale;
I32 contains_i;
within pattern */
int num_code_blocks; /* size of code_blocks[] */
int code_index; /* next code_blocks[] slot */
+ SSize_t maxlen; /* mininum possible number of chars in string to match */
#if ADD_TO_REGEXEC
char *starttry; /* -Dr: where regtry was called. */
#define RExC_starttry (pRExC_state->starttry)
#define RExC_parse (pRExC_state->parse)
#define RExC_whilem_seen (pRExC_state->whilem_seen)
#ifdef RE_TRACK_PATTERN_OFFSETS
-#define RExC_offsets (pRExC_state->rxi->u.offsets) /* I am not like the others */
+#define RExC_offsets (pRExC_state->rxi->u.offsets) /* I am not like the
+ others */
#endif
#define RExC_emit (pRExC_state->emit)
#define RExC_emit_dummy (pRExC_state->emit_dummy)
#define RExC_sawback (pRExC_state->sawback)
#define RExC_seen (pRExC_state->seen)
#define RExC_size (pRExC_state->size)
+#define RExC_maxlen (pRExC_state->maxlen)
#define RExC_npar (pRExC_state->npar)
#define RExC_nestroot (pRExC_state->nestroot)
#define RExC_extralen (pRExC_state->extralen)
#define RExC_paren_names (pRExC_state->paren_names)
#define RExC_recurse (pRExC_state->recurse)
#define RExC_recurse_count (pRExC_state->recurse_count)
+#define RExC_study_chunk_recursed (pRExC_state->study_chunk_recursed)
+#define RExC_study_chunk_recursed_bytes \
+ (pRExC_state->study_chunk_recursed_bytes)
#define RExC_in_lookbehind (pRExC_state->in_lookbehind)
#define RExC_contains_locale (pRExC_state->contains_locale)
#define RExC_contains_i (pRExC_state->contains_i)
During optimisation we recurse through the regexp program performing
various inplace (keyhole style) optimisations. In addition study_chunk
and scan_commit populate this data structure with information about
- what strings MUST appear in the pattern. We look for the longest
+ what strings MUST appear in the pattern. We look for the longest
string that must appear at a fixed location, and we look for the
longest string that may appear at a floating location. So for instance
in the pattern:
-
+
/FOO[xX]A.*B[xX]BAR/
-
+
Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
strings (because they follow a .* construct). study_chunk will identify
both FOO and BAR as being the longest fixed and floating strings respectively.
-
+
The strings can be composites, for instance
-
+
/(f)(o)(o)/
-
+
will result in a composite fixed substring 'foo'.
-
+
For each string some basic information is maintained:
-
+
- offset or min_offset
This is the position the string must appear at, or not before.
It also implicitly (when combined with minlenp) tells us how many
characters must match before the string we are searching for.
Likewise when combined with minlenp and the length of the string it
- tells us how many characters must appear after the string we have
+ tells us how many characters must appear after the string we have
found.
-
+
- max_offset
Only used for floating strings. This is the rightmost point that
the string can appear at. If set to SSize_t_MAX it indicates that the
string can occur infinitely far to the right.
-
+
- minlenp
A pointer to the minimum number of characters of the pattern that the
string was found inside. This is important as in the case of positive
- lookahead or positive lookbehind we can have multiple patterns
+ lookahead or positive lookbehind we can have multiple patterns
involved. Consider
-
+
/(?=FOO).*F/
-
+
The minimum length of the pattern overall is 3, the minimum length
of the lookahead part is 3, but the minimum length of the part that
- will actually match is 1. So 'FOO's minimum length is 3, but the
+ will actually match is 1. So 'FOO's minimum length is 3, but the
minimum length for the F is 1. This is important as the minimum length
- is used to determine offsets in front of and behind the string being
+ is used to determine offsets in front of and behind the string being
looked for. Since strings can be composites this is the length of the
pattern at the time it was committed with a scan_commit. Note that
the length is calculated by study_chunk, so that the minimum lengths
- are not known until the full pattern has been compiled, thus the
+ are not known until the full pattern has been compiled, thus the
pointer to the value.
-
+
- lookbehind
-
+
In the case of lookbehind the string being searched for can be
- offset past the start point of the final matching string.
+ offset past the start point of the final matching string.
If this value was just blithely removed from the min_offset it would
invalidate some of the calculations for how many chars must match
before or after (as they are derived from min_offset and minlen and
- the length of the string being searched for).
+ the length of the string being searched for).
When the final pattern is compiled and the data is moved from the
scan_data_t structure into the regexp structure the information
- about lookbehind is factored in, with the information that would
- have been lost precalculated in the end_shift field for the
+ about lookbehind is factored in, with the information that would
+ have been lost precalculated in the end_shift field for the
associated string.
The fields pos_min and pos_delta are used to store the minimum offset
- and the delta to the maximum offset at the current point in the pattern.
+ and the delta to the maximum offset at the current point in the pattern.
*/
#define SCF_WHILEM_VISITED_POS 0x2000
#define SCF_TRIE_RESTUDY 0x4000 /* Do restudy? */
-#define SCF_SEEN_ACCEPT 0x8000
+#define SCF_SEEN_ACCEPT 0x8000
#define SCF_TRIE_DOING_RESTUDY 0x10000
#define UTF cBOOL(RExC_utf8)
/* The enums for all these are ordered so things work out correctly */
#define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET)
-#define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_DEPENDS_CHARSET)
+#define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) \
+ == REGEX_DEPENDS_CHARSET)
#define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET)
-#define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) >= REGEX_UNICODE_CHARSET)
-#define ASCII_RESTRICTED (get_regex_charset(RExC_flags) == REGEX_ASCII_RESTRICTED_CHARSET)
-#define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) >= REGEX_ASCII_RESTRICTED_CHARSET)
-#define ASCII_FOLD_RESTRICTED (get_regex_charset(RExC_flags) == REGEX_ASCII_MORE_RESTRICTED_CHARSET)
+#define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) \
+ >= REGEX_UNICODE_CHARSET)
+#define ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
+ == REGEX_ASCII_RESTRICTED_CHARSET)
+#define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
+ >= REGEX_ASCII_RESTRICTED_CHARSET)
+#define ASCII_FOLD_RESTRICTED (get_regex_charset(RExC_flags) \
+ == REGEX_ASCII_MORE_RESTRICTED_CHARSET)
#define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
+/* For programs that want to be strictly Unicode compatible by dying if any
+ * attempt is made to match a non-Unicode code point against a Unicode
+ * property. */
+#define ALWAYS_WARN_SUPER ckDEAD(packWARN(WARN_NON_UNICODE))
+
#define OOB_NAMEDCLASS -1
/* There is no code point that is out-of-bounds, so this is problematic. But
#define MARKER1 "<-- HERE" /* marker as it appears in the description */
#define MARKER2 " <-- HERE " /* marker as it appears within the regex */
-#define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%"UTF8f MARKER2 "%"UTF8f"/"
+#define REPORT_LOCATION " in regex; marked by " MARKER1 \
+ " in m/%"UTF8f MARKER2 "%"UTF8f"/"
#define REPORT_LOCATION_ARGS(offset) \
UTF8fARG(UTF, offset, RExC_precomp), \
if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
} STMT_END
-/* Macros for recording node offsets. 20001227 mjd@plover.com
+/* Macros for recording node offsets. 20001227 mjd@plover.com
* Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
* element 2*n-1 of the array. Element #2n holds the byte length node #n.
* Element 0 holds the number n.
#define Set_Node_Length_To_R(node,len)
#define Set_Node_Length(node,len)
#define Set_Node_Cur_Length(node,start)
-#define Node_Offset(n)
-#define Node_Length(n)
+#define Node_Offset(n)
+#define Node_Length(n)
#define Set_Node_Offset_Length(node,offset,len)
#define ProgLen(ri) ri->u.proglen
#define SetProgLen(ri,x) ri->u.proglen = x
MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
__LINE__, (int)(node), (int)(byte))); \
if((node) < 0) { \
- Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
+ Perl_croak(aTHX_ "value of node is %d in Offset macro", \
+ (int)(node)); \
} else { \
RExC_offsets[2*(node)-1] = (byte); \
} \
MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \
__LINE__, (int)(node), (int)(len))); \
if((node) < 0) { \
- Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
+ Perl_croak(aTHX_ "value of node is %d in Length macro", \
+ (int)(node)); \
} else { \
RExC_offsets[2*(node)] = (len); \
} \
#define EXPERIMENTAL_INPLACESCAN
#endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
+#define DEBUG_RExC_seen() \
+ DEBUG_OPTIMISE_MORE_r({ \
+ PerlIO_printf(Perl_debug_log,"RExC_seen: "); \
+ \
+ if (RExC_seen & REG_ZERO_LEN_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_ZERO_LEN_SEEN "); \
+ \
+ if (RExC_seen & REG_LOOKBEHIND_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_LOOKBEHIND_SEEN "); \
+ \
+ if (RExC_seen & REG_GPOS_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_GPOS_SEEN "); \
+ \
+ if (RExC_seen & REG_CANY_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_CANY_SEEN "); \
+ \
+ if (RExC_seen & REG_RECURSE_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_RECURSE_SEEN "); \
+ \
+ if (RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_TOP_LEVEL_BRANCHES_SEEN "); \
+ \
+ if (RExC_seen & REG_VERBARG_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_VERBARG_SEEN "); \
+ \
+ if (RExC_seen & REG_CUTGROUP_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_CUTGROUP_SEEN "); \
+ \
+ if (RExC_seen & REG_RUN_ON_COMMENT_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_RUN_ON_COMMENT_SEEN "); \
+ \
+ if (RExC_seen & REG_UNFOLDED_MULTI_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_UNFOLDED_MULTI_SEEN "); \
+ \
+ if (RExC_seen & REG_GOSTART_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_GOSTART_SEEN "); \
+ \
+ if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) \
+ PerlIO_printf(Perl_debug_log,"REG_UNBOUNDED_QUANTIFIER_SEEN "); \
+ \
+ PerlIO_printf(Perl_debug_log,"\n"); \
+ });
+
#define DEBUG_STUDYDATA(str,data,depth) \
DEBUG_OPTIMISE_MORE_r(if(data){ \
PerlIO_printf(Perl_debug_log, \
PERL_ARGS_ASSERT_SSC_ANYTHING;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
ssc->invlist = sv_2mortal(_new_invlist(2)); /* mortalize so won't leak */
_append_range_to_invlist(ssc->invlist, 0, UV_MAX);
STATIC int
S_ssc_is_anything(pTHX_ const regnode_ssc *ssc)
{
- /* Returns TRUE if the SSC 'ssc' can match the empty string or any code
- * point */
+ /* Returns TRUE if the SSC 'ssc' can match the empty string and any code
+ * point; FALSE otherwise. Thus, this is used to see if using 'ssc' buys
+ * us anything: if the function returns TRUE, 'ssc' hasn't been restricted
+ * in any way, so there's no point in using it */
UV start, end;
bool ret;
PERL_ARGS_ASSERT_SSC_IS_ANYTHING;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
- if (! ANYOF_FLAGS(ssc) & ANYOF_EMPTY_STRING) {
+ if (! (ANYOF_FLAGS(ssc) & ANYOF_EMPTY_STRING)) {
return FALSE;
}
PERL_ARGS_ASSERT_SSC_INIT;
Zero(ssc, 1, regnode_ssc);
- OP(ssc) = ANYOF_SYNTHETIC;
+ set_ANYOF_SYNTHETIC(ssc);
ARG_SET(ssc, ANYOF_NONBITMAP_EMPTY);
ssc_anything(ssc);
if (RExC_contains_locale) {
ANYOF_POSIXL_SETALL(ssc);
ANYOF_FLAGS(ssc) |= ANYOF_LOCALE|ANYOF_POSIXL;
- if (RExC_contains_i) {
- ANYOF_FLAGS(ssc) |= ANYOF_LOC_FOLD;
- }
}
else {
ANYOF_POSIXL_ZERO(ssc);
PERL_ARGS_ASSERT_SSC_IS_CP_POSIXL_INIT;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
invlist_iterinit(ssc->invlist);
ret = invlist_iternext(ssc->invlist, &start, &end)
return FALSE;
}
- if (RExC_contains_locale) {
- if (! (ANYOF_FLAGS(ssc) & ANYOF_LOCALE)
- || ! (ANYOF_FLAGS(ssc) & ANYOF_POSIXL)
- || ! ANYOF_POSIXL_TEST_ALL_SET(ssc))
- {
- return FALSE;
- }
- if (RExC_contains_i && ! (ANYOF_FLAGS(ssc) & ANYOF_LOC_FOLD)) {
- return FALSE;
- }
+ if (RExC_contains_locale
+ && ! ((ANYOF_FLAGS(ssc) & ANYOF_LOCALE)
+ || ! (ANYOF_FLAGS(ssc) & ANYOF_POSIXL)
+ || ! ANYOF_POSIXL_TEST_ALL_SET(ssc)))
+ {
+ return FALSE;
}
return TRUE;
STATIC SV*
S_get_ANYOF_cp_list_for_ssc(pTHX_ const RExC_state_t *pRExC_state,
- const regnode_charclass_posixl* const node)
+ const regnode_charclass_posixl_fold* const node)
{
/* Returns a mortal inversion list defining which code points are matched
* by 'node', which is of type ANYOF. Handles complementing the result if
* appropriate. If some code points aren't knowable at this time, the
- * returned list must, and will, contain every possible code point. */
+ * returned list must, and will, contain every code point that is a
+ * possibility. */
SV* invlist = sv_2mortal(_new_invlist(0));
unsigned int i;
const U32 n = ARG(node);
+ bool new_node_has_latin1 = FALSE;
PERL_ARGS_ASSERT_GET_ANYOF_CP_LIST_FOR_SSC;
for (i = 0; i < 256; i++) {
if (ANYOF_BITMAP_TEST(node, i)) {
invlist = add_cp_to_invlist(invlist, i);
+ new_node_has_latin1 = TRUE;
}
}
/* If this can match all upper Latin1 code points, have to add them
* as well */
- if (ANYOF_FLAGS(node) & ANYOF_NON_UTF8_LATIN1_ALL) {
+ if (ANYOF_FLAGS(node) & ANYOF_NON_UTF8_NON_ASCII_ALL) {
_invlist_union(invlist, PL_UpperLatin1, &invlist);
}
if (ANYOF_FLAGS(node) & ANYOF_INVERT) {
_invlist_invert(invlist);
}
+ else if (new_node_has_latin1 && ANYOF_FLAGS(node) & ANYOF_LOC_FOLD) {
+
+ /* Under /li, any 0-255 could fold to any other 0-255, depending on the
+ * locale. We can skip this if there are no 0-255 at all. */
+ _invlist_union(invlist, PL_Latin1, &invlist);
+ }
+
+ /* Similarly add the UTF-8 locale possible matches */
+ if (ANYOF_FLAGS(node) & ANYOF_LOC_FOLD && ANYOF_UTF8_LOCALE_INVLIST(node))
+ {
+ _invlist_union_maybe_complement_2nd(invlist,
+ ANYOF_UTF8_LOCALE_INVLIST(node),
+ ANYOF_FLAGS(node) & ANYOF_INVERT,
+ &invlist);
+ }
return invlist;
}
* The flags 'and_with' should not come from another SSC (otherwise the
* EMPTY_STRING flag won't work) */
- const U8 ssc_only_flags = ANYOF_FLAGS(ssc) & ~ANYOF_LOCALE_FLAGS;
+ const U8 ssc_only_flags = ANYOF_FLAGS(ssc) & ~ANYOF_COMMON_FLAGS;
PERL_ARGS_ASSERT_SSC_FLAGS_AND;
/* Use just the SSC-related flags from 'and_with' */
- ANYOF_FLAGS(ssc) &= (and_with & ANYOF_LOCALE_FLAGS);
+ ANYOF_FLAGS(ssc) &= (and_with & ANYOF_COMMON_FLAGS);
ANYOF_FLAGS(ssc) |= ssc_only_flags;
}
PERL_ARGS_ASSERT_SSC_AND;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
/* 'and_with' is used as-is if it too is an SSC; otherwise have to extract
* the code point inversion list and just the relevant flags */
- if (OP(and_with) == ANYOF_SYNTHETIC) {
+ if (is_ANYOF_SYNTHETIC(and_with)) {
anded_cp_list = and_with->invlist;
anded_flags = ANYOF_FLAGS(and_with);
+
+ /* XXX This is a kludge around what appears to be deficiencies in the
+ * optimizer. If we make S_ssc_anything() add in the WARN_SUPER flag,
+ * there are paths through the optimizer where it doesn't get weeded
+ * out when it should. And if we don't make some extra provision for
+ * it like the code just below, it doesn't get added when it should.
+ * This solution is to add it only when AND'ing, which is here, and
+ * only when what is being AND'ed is the pristine, original node
+ * matching anything. Thus it is like adding it to ssc_anything() but
+ * only when the result is to be AND'ed. Probably the same solution
+ * could be adopted for the same problem we have with /l matching,
+ * which is solved differently in S_ssc_init(), and that would lead to
+ * fewer false positives than that solution has. But if this solution
+ * creates bugs, the consequences are only that a warning isn't raised
+ * that should be; while the consequences for having /l bugs is
+ * incorrect matches */
+ if (ssc_is_anything(and_with)) {
+ anded_flags |= ANYOF_WARN_SUPER;
+ }
}
else {
anded_cp_list = get_ANYOF_cp_list_for_ssc(pRExC_state,
- (regnode_charclass_posixl*) and_with);
- anded_flags = ANYOF_FLAGS(and_with) & ANYOF_LOCALE_FLAGS;
+ (regnode_charclass_posixl_fold*) and_with);
+ anded_flags = ANYOF_FLAGS(and_with) & ANYOF_COMMON_FLAGS;
}
ANYOF_FLAGS(ssc) &= anded_flags;
* */
if ((ANYOF_FLAGS(and_with) & ANYOF_INVERT)
- && OP(and_with) != ANYOF_SYNTHETIC)
+ && ! is_ANYOF_SYNTHETIC(and_with))
{
unsigned int i;
* standard, in particular almost everything by Microsoft.
* The loop below just changes e.g., \w into \W and vice versa */
- regnode_charclass_posixl temp;
+ regnode_charclass_posixl_fold temp;
int add = 1; /* To calculate the index of the complement */
ANYOF_POSIXL_ZERO(&temp);
} /* else ssc already has no posixes */
} /* else: Not inverted. This routine is a no-op if 'and_with' is an SSC
in its initial state */
- else if (OP(and_with) != ANYOF_SYNTHETIC
+ else if (! is_ANYOF_SYNTHETIC(and_with)
|| ! ssc_is_cp_posixl_init(pRExC_state, and_with))
{
/* But if 'ssc' is in its initial state, the result is just 'and_with';
* copy it over 'ssc' */
if (ssc_is_cp_posixl_init(pRExC_state, ssc)) {
- if (OP(and_with) == ANYOF_SYNTHETIC) {
+ if (is_ANYOF_SYNTHETIC(and_with)) {
StructCopy(and_with, ssc, regnode_ssc);
}
else {
PERL_ARGS_ASSERT_SSC_OR;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
/* 'or_with' is used as-is if it too is an SSC; otherwise have to extract
* the code point inversion list and just the relevant flags */
- if (OP(or_with) == ANYOF_SYNTHETIC) {
+ if (is_ANYOF_SYNTHETIC(or_with)) {
ored_cp_list = or_with->invlist;
ored_flags = ANYOF_FLAGS(or_with);
}
else {
ored_cp_list = get_ANYOF_cp_list_for_ssc(pRExC_state,
- (regnode_charclass_posixl*) or_with);
- ored_flags = ANYOF_FLAGS(or_with) & ANYOF_LOCALE_FLAGS;
+ (regnode_charclass_posixl_fold*) or_with);
+ ored_flags = ANYOF_FLAGS(or_with) & ANYOF_COMMON_FLAGS;
}
ANYOF_FLAGS(ssc) |= ored_flags;
* */
if ((ANYOF_FLAGS(or_with) & ANYOF_INVERT)
- && OP(or_with) != ANYOF_SYNTHETIC)
+ && ! is_ANYOF_SYNTHETIC(or_with))
{
/* We ignore P2, leaving P1 going forward */
}
{
PERL_ARGS_ASSERT_SSC_UNION;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
_invlist_union_maybe_complement_2nd(ssc->invlist,
invlist,
{
PERL_ARGS_ASSERT_SSC_INTERSECTION;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
_invlist_intersection_maybe_complement_2nd(ssc->invlist,
invlist,
{
PERL_ARGS_ASSERT_SSC_ADD_RANGE;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
ssc->invlist = _add_range_to_invlist(ssc->invlist, start, end);
}
PERL_ARGS_ASSERT_SSC_CP_AND;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
cp_list = add_cp_to_invlist(cp_list, cp);
ssc_intersection(ssc, cp_list,
PERL_ARGS_ASSERT_SSC_CLEAR_LOCALE;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
ANYOF_POSIXL_ZERO(ssc);
ANYOF_FLAGS(ssc) &= ~ANYOF_LOCALE_FLAGS;
PERL_ARGS_ASSERT_SSC_FINALIZE;
- assert(OP(ssc) == ANYOF_SYNTHETIC);
+ assert(is_ANYOF_SYNTHETIC(ssc));
/* The code in this file assumes that all but these flags aren't relevant
* to the SSC, except ANYOF_EMPTY_STRING, which should be cleared by the
* time we reach here */
- assert(! (ANYOF_FLAGS(ssc) & ~ANYOF_LOCALE_FLAGS));
+ assert(! (ANYOF_FLAGS(ssc) & ~ANYOF_COMMON_FLAGS));
populate_ANYOF_from_invlist( (regnode *) ssc, &invlist);
set_ANYOF_arg(pRExC_state, (regnode *) ssc, invlist, NULL, NULL, FALSE);
+ /* The code points that could match under /li are already incorporated into
+ * the inversion list and bit map */
+ ANYOF_FLAGS(ssc) &= ~ANYOF_LOC_FOLD;
+
assert(! (ANYOF_FLAGS(ssc) & ANYOF_LOCALE) || RExC_contains_locale);
}
#define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
#define TRIE_LIST_CUR(state) ( TRIE_LIST_ITEM( state, 0 ).forid )
#define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
-#define TRIE_LIST_USED(idx) ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
+#define TRIE_LIST_USED(idx) ( trie->states[state].trans.list \
+ ? (TRIE_LIST_CUR( idx ) - 1) \
+ : 0 )
#ifdef DEBUGGING
for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
SV ** const tmp = av_fetch( revcharmap, state, 0);
if ( tmp ) {
- PerlIO_printf( Perl_debug_log, "%*s",
+ PerlIO_printf( Perl_debug_log, "%*s",
colwidth,
- pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
+ pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
PL_colors[0], PL_colors[1],
(SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_ESCAPE_FIRSTCHAR
- )
+ PERL_PV_ESCAPE_FIRSTCHAR
+ )
);
}
}
for( state = 1 ; state < trie->statecount ; state++ ) {
const U32 base = trie->states[ state ].trans.base;
- PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
+ PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|",
+ (int)depth * 2 + 2,"", (UV)state);
if ( trie->states[ state ].wordnum ) {
- PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
+ PerlIO_printf( Perl_debug_log, " W%4X",
+ trie->states[ state ].wordnum );
} else {
PerlIO_printf( Perl_debug_log, "%6s", "" );
}
while( ( base + ofs < trie->uniquecharcount ) ||
( base + ofs - trie->uniquecharcount < trie->lasttrans
- && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
+ && trie->trans[ base + ofs - trie->uniquecharcount ].check
+ != state))
ofs++;
PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
- if ( ( base + ofs >= trie->uniquecharcount ) &&
- ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
- trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
+ if ( ( base + ofs >= trie->uniquecharcount )
+ && ( base + ofs - trie->uniquecharcount
+ < trie->lasttrans )
+ && trie->trans[ base + ofs
+ - trie->uniquecharcount ].check == state )
{
PerlIO_printf( Perl_debug_log, "%*"UVXf,
colwidth,
- (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
+ (UV)trie->trans[ base + ofs
+ - trie->uniquecharcount ].next );
} else {
PerlIO_printf( Perl_debug_log, "%*s",colwidth," ." );
}
}
PerlIO_printf( Perl_debug_log, "\n" );
}
- PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=", (int)depth*2, "");
+ PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=",
+ (int)depth*2, "");
for (word=1; word <= trie->wordcount; word++) {
PerlIO_printf(Perl_debug_log, " %d:(%d,%d)",
(int)word, (int)(trie->wordinfo[word].prev),
(int)(trie->wordinfo[word].len));
}
PerlIO_printf(Perl_debug_log, "\n" );
-}
+}
/*
Dumps a fully constructed but uncompressed trie in list form.
- List tries normally only are used for construction when the number of
+ List tries normally only are used for construction when the number of
possible chars (trie->uniquecharcount) is very high.
Used for debugging make_trie().
*/
PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
(int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
"------:-----+-----------------\n" );
-
+
for( state=1 ; state < next_alloc ; state ++ ) {
U16 charid;
-
+
PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
(int)depth * 2 + 2,"", (UV)state );
if ( ! trie->states[ state ].wordnum ) {
);
}
for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
- SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
+ SV ** const tmp = av_fetch( revcharmap,
+ TRIE_LIST_ITEM(state,charid).forid, 0);
if ( tmp ) {
PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
colwidth,
- pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
- PL_colors[0], PL_colors[1],
- (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_ESCAPE_FIRSTCHAR
+ pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp),
+ colwidth,
+ PL_colors[0], PL_colors[1],
+ (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
+ | PERL_PV_ESCAPE_FIRSTCHAR
) ,
TRIE_LIST_ITEM(state,charid).forid,
(UV)TRIE_LIST_ITEM(state,charid).newstate
);
- if (!(charid % 10))
+ if (!(charid % 10))
PerlIO_printf(Perl_debug_log, "\n%*s| ",
(int)((depth * 2) + 14), "");
}
}
PerlIO_printf( Perl_debug_log, "\n");
}
-}
+}
/*
Dumps a fully constructed but uncompressed trie in table form.
- This is the normal DFA style state transition table, with a few
- twists to facilitate compression later.
+ This is the normal DFA style state transition table, with a few
+ twists to facilitate compression later.
Used for debugging make_trie().
*/
STATIC void
GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
-
+
/*
print out the table precompression so that we can do a visual check
that they are identical.
*/
-
+
PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
SV ** const tmp = av_fetch( revcharmap, charid, 0);
if ( tmp ) {
- PerlIO_printf( Perl_debug_log, "%*s",
+ PerlIO_printf( Perl_debug_log, "%*s",
colwidth,
- pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
+ pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
PL_colors[0], PL_colors[1],
(SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_ESCAPE_FIRSTCHAR
- )
+ PERL_PV_ESCAPE_FIRSTCHAR
+ )
);
}
}
for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
- PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
+ PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
(int)depth * 2 + 2,"",
(UV)TRIE_NODENUM( state ) );
PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
}
if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
- PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
+ PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n",
+ (UV)trie->trans[ state ].check );
} else {
- PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
+ PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n",
+ (UV)trie->trans[ state ].check,
trie->states[ TRIE_NODENUM( state ) ].wordnum );
}
}
\
if ( noper_next < tail ) { \
if (!trie->jump) \
- trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, sizeof(U16) ); \
+ trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, \
+ sizeof(U16) ); \
trie->jump[curword] = (U16)(noper_next - convert); \
if (!jumper) \
jumper = noper_next; \
#define MADE_EXACT_TRIE 4
STATIC I32
-S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth)
+S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
+ regnode *first, regnode *last, regnode *tail,
+ U32 word_count, U32 flags, U32 depth)
{
dVAR;
/* first pass, loop through and scan words */
case EXACTFU_SS:
case EXACTFU: folder = PL_fold_latin1; break;
case EXACTF: folder = PL_fold; break;
- case EXACTFL: folder = PL_fold_locale; break;
default: Perl_croak( aTHX_ "panic! In trie construction, unknown node type %u %s", (unsigned) flags, PL_reg_name[flags] );
}
sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
}
DEBUG_TRIE_COMPILE_r({
- PerlIO_printf( Perl_debug_log,
- "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
- (int)depth * 2 + 2, "",
- REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
- REG_NODE_NUM(last), REG_NODE_NUM(tail),
- (int)depth);
+ PerlIO_printf( Perl_debug_log,
+ "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
+ (int)depth * 2 + 2, "",
+ REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
+ REG_NODE_NUM(last), REG_NODE_NUM(tail), (int)depth);
});
-
+
/* Find the node we are going to overwrite */
if ( first == startbranch && OP( last ) != BRANCH ) {
/* whole branch chain */
/* branch sub-chain */
convert = NEXTOPER( first );
}
-
+
/* -- First loop and Setup --
We first traverse the branches and scan each word to determine if it
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
- native representation of the character value as the key and IV's for the
- coded index.
+ (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.
*TODO* If we keep track of how many times each character is used we can
remap the columns so that the table compression later on is more
U32 wordlen = 0; /* required init */
STRLEN minbytes = 0;
STRLEN maxbytes = 0;
- bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the bitmap?*/
+ bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the
+ bitmap?*/
if (OP(noper) == NOTHING) {
regnode *noper_next= regnext(noper);
foldlen -= UTF8SKIP(uc);
}
else {
- foldlen = is_MULTI_CHAR_FOLD_utf8_safe(uc, e);
+ foldlen = is_MULTI_CHAR_FOLD_utf8(uc);
minbytes++;
}
}
foldlen--;
}
else {
- foldlen = is_MULTI_CHAR_FOLD_latin1_safe(uc, e);
+ foldlen = is_MULTI_CHAR_FOLD_latin1(uc);
minbytes++;
}
}
}
} /* end first pass */
DEBUG_TRIE_COMPILE_r(
- PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
+ PerlIO_printf( Perl_debug_log,
+ "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
(int)depth * 2 + 2,"",
( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
(int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
prev_states[1] = 0;
- if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
+ if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1)
+ > SvIV(re_trie_maxbuff) )
+ {
/*
Second Pass -- Array Of Lists Representation
STRLEN transcount = 1;
- DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
+ DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
"%*sCompiling trie using list compiler\n",
(int)depth * 2 + 2, ""));
if ( uvc < 256 ) {
charid = trie->charmap[ uvc ];
} else {
- SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
+ SV** const svpp = hv_fetch( widecharmap,
+ (char*)&uvc,
+ sizeof( UV ),
+ 0);
if ( !svpp ) {
charid = 0;
} else {
charid=(U16)SvIV( *svpp );
}
}
- /* charid is now 0 if we dont know the char read, or nonzero if we do */
+ /* charid is now 0 if we dont know the char read, or
+ * nonzero if we do */
if ( charid ) {
U16 check;
if ( !trie->states[ state ].trans.list ) {
TRIE_LIST_NEW( state );
}
- for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
- if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
+ for ( check = 1;
+ check <= TRIE_LIST_USED( state );
+ check++ )
+ {
+ if ( TRIE_LIST_ITEM( state, check ).forid
+ == charid )
+ {
newstate = TRIE_LIST_ITEM( state, check ).newstate;
break;
}
} /* end second pass */
/* next alloc is the NEXT state to be allocated */
- trie->statecount = next_alloc;
+ trie->statecount = next_alloc;
trie->states = (reg_trie_state *)
PerlMemShared_realloc( trie->states,
next_alloc
PerlMemShared_realloc( trie->trans,
transcount
* sizeof(reg_trie_trans) );
- Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
+ Zero( trie->trans + (transcount / 2),
+ transcount / 2,
+ reg_trie_trans );
}
base = trie->uniquecharcount + tp - minid;
if ( maxid == minid ) {
for ( ; zp < tp ; zp++ ) {
if ( ! trie->trans[ zp ].next ) {
base = trie->uniquecharcount + zp - minid;
- trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
+ trie->trans[ zp ].next = TRIE_LIST_ITEM( state,
+ 1).newstate;
trie->trans[ zp ].check = state;
set = 1;
break;
}
}
if ( !set ) {
- trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
+ trie->trans[ tp ].next = TRIE_LIST_ITEM( state,
+ 1).newstate;
trie->trans[ tp ].check = state;
tp++;
zp = tp;
}
} else {
for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
- const U32 tid = base - trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
- trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
+ const U32 tid = base
+ - trie->uniquecharcount
+ + TRIE_LIST_ITEM( state, idx ).forid;
+ trie->trans[ tid ].next = TRIE_LIST_ITEM( state,
+ idx ).newstate;
trie->trans[ tid ].check = state;
}
tp += ( maxid - minid + 1 );
we have to use TRIE_NODENUM() to convert.
*/
- DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
+ DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
"%*sCompiling trie using table compiler\n",
(int)depth * 2 + 2, ""));
if ( uvc < 256 ) {
charid = trie->charmap[ uvc ];
} else {
- SV* const * const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
+ SV* const * const svpp = hv_fetch( widecharmap,
+ (char*)&uvc,
+ sizeof( UV ),
+ 0);
charid = svpp ? (U16)SvIV(*svpp) : 0;
}
if ( charid ) {
} else {
Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
}
- /* charid is now 0 if we dont know the char read, or nonzero if we do */
+ /* charid is now 0 if we dont know the char read, or
+ * nonzero if we do */
}
}
accept_state = TRIE_NODENUM( state );
U32 used = trie->trans[ stateidx ].check;
trie->trans[ stateidx ].check = 0;
- for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
+ for ( charid = 0;
+ used && charid < trie->uniquecharcount;
+ charid++ )
+ {
if ( flag || trie->trans[ stateidx + charid ].next ) {
if ( trie->trans[ stateidx + charid ].next ) {
if (o_used == 1) {
break;
}
}
- trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
- trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
+ trie->states[ state ].trans.base
+ = zp
+ + trie->uniquecharcount
+ - charid ;
+ trie->trans[ zp ].next
+ = SAFE_TRIE_NODENUM( trie->trans[ stateidx
+ + charid ].next );
trie->trans[ zp ].check = state;
if ( ++zp > pos ) pos = zp;
break;
}
if ( !flag ) {
flag = 1;
- trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
+ trie->states[ state ].trans.base
+ = pos + trie->uniquecharcount - charid ;
}
- trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
+ trie->trans[ pos ].next
+ = SAFE_TRIE_NODENUM(
+ trie->trans[ stateidx + charid ].next );
trie->trans[ pos ].check = state;
pos++;
}
PerlMemShared_realloc( trie->states, laststate
* sizeof(reg_trie_state) );
DEBUG_TRIE_COMPILE_MORE_r(
- PerlIO_printf( Perl_debug_log,
- "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
- (int)depth * 2 + 2,"",
- (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
- (IV)next_alloc,
- (IV)pos,
- ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
+ PerlIO_printf( Perl_debug_log,
+ "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
+ (int)depth * 2 + 2,"",
+ (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount
+ + 1 ),
+ (IV)next_alloc,
+ (IV)pos,
+ ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
);
} /* end table compress */
}
DEBUG_TRIE_COMPILE_MORE_r(
- PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log,
+ "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
(int)depth * 2 + 2, "",
(UV)trie->statecount,
(UV)trie->lasttrans)
PerlMemShared_realloc( trie->trans, trie->lasttrans
* sizeof(reg_trie_trans) );
- { /* Modify the program and insert the new TRIE node */
+ { /* Modify the program and insert the new TRIE node */
U8 nodetype =(U8)(flags & 0xFF);
char *str=NULL;
-
+
#ifdef DEBUGGING
regnode *optimize = NULL;
#ifdef RE_TRACK_PATTERN_OFFSETS
});
}
DEBUG_OPTIMISE_r(
- PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
+ PerlIO_printf(Perl_debug_log,
+ "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
(int)depth * 2 + 2, "",
(UV)mjd_offset, (UV)mjd_nodelen)
);
#endif
- /* But first we check to see if there is a common prefix we can
+ /* But first we check to see if there is a common prefix we can
split out as an EXACT and put in front of the TRIE node. */
trie->startstate= 1;
if ( trie->bitmap && !widecharmap && !trie->jump ) {
PerlIO_printf( Perl_debug_log,
"%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
(int)depth * 2 + 2, "",
- (UV)state, (UV)idx,
- pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
+ (UV)state, (UV)idx,
+ pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
PL_colors[0], PL_colors[1],
(SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_ESCAPE_FIRSTCHAR
+ PERL_PV_ESCAPE_FIRSTCHAR
)
);
});
while (len--)
*str++ = *ch++;
} else {
-#ifdef DEBUGGING
+#ifdef DEBUGGING
if (state>1)
DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
#endif
}
}
}
- if (!jumper)
- jumper = last;
+ if (!jumper)
+ jumper = last;
if ( trie->maxlen ) {
NEXT_OFF( convert ) = (U16)(tail - convert);
ARG_SET( convert, data_slot );
- /* Store the offset to the first unabsorbed branch in
- jump[0], which is otherwise unused by the jump logic.
+ /* Store the offset to the first unabsorbed branch in
+ jump[0], which is otherwise unused by the jump logic.
We use this when dumping a trie and during optimisation. */
- if (trie->jump)
+ if (trie->jump)
trie->jump[0] = (U16)(nextbranch - convert);
-
+
/* If the start state is not accepting (meaning there is no empty string/NOTHING)
* and there is a bitmap
* and the first "jump target" node we found leaves enough room
Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
PerlMemShared_free(trie->bitmap);
trie->bitmap= NULL;
- } else
+ } else
OP( convert ) = TRIE;
/* store the type in the flags */
convert->flags = nodetype;
DEBUG_r({
- optimize = convert
- + NODE_STEP_REGNODE
+ optimize = convert
+ + NODE_STEP_REGNODE
+ regarglen[ OP( convert ) ];
});
- /* XXX We really should free up the resource in trie now,
+ /* XXX We really should free up the resource in trie now,
as we won't use them - (which resources?) dmq */
}
/* needed for dumping*/
while ( ++opt < optimize) {
Set_Node_Offset_Length(opt,0,0);
}
- /*
- Try to clean up some of the debris left after the
+ /*
+ Try to clean up some of the debris left after the
optimisation.
*/
while( optimize < jumper ) {
#else
SvREFCNT_dec_NN(revcharmap);
#endif
- return trie->jump
- ? MADE_JUMP_TRIE
- : trie->startstate>1
- ? MADE_EXACT_TRIE
+ return trie->jump
+ ? MADE_JUMP_TRIE
+ : trie->startstate>1
+ ? MADE_EXACT_TRIE
: MADE_TRIE;
}
fail[ 0 ] = fail[ 1 ] = 0;
DEBUG_TRIE_COMPILE_r({
PerlIO_printf(Perl_debug_log,
- "%*sStclass Failtable (%"UVuf" states): 0",
+ "%*sStclass Failtable (%"UVuf" states): 0",
(int)(depth * 2), "", (UV)numstates
);
for( q_read=1; q_read<numstates; q_read++ ) {
PerlIO_printf(Perl_debug_log, "\n");
});
Safefree(q);
- /*RExC_seen |= REG_SEEN_TRIEDFA;*/
+ /*RExC_seen |= REG_TRIEDFA_SEEN;*/
}
*
* If a node is to match under /i (folded), the number of characters it matches
* can be different than its character length if it contains a multi-character
- * fold. *min_subtract is set to the total delta of the input nodes.
+ * fold. *min_subtract is set to the total delta number of characters of the
+ * input nodes.
*
- * And *has_exactf_sharp_s is set to indicate whether or not the node is EXACTF
- * and contains LATIN SMALL LETTER SHARP S
+ * And *unfolded_multi_char is set to indicate whether or not the node contains
+ * an unfolded multi-char fold. This happens when whether the fold is valid or
+ * not won't be known until runtime; namely for EXACTF nodes that contain LATIN
+ * SMALL LETTER SHARP S, as only if the target string being matched against
+ * turns out to be UTF-8 is that fold valid; and also for EXACTFL nodes whose
+ * folding rules depend on the locale in force at runtime. (Multi-char folds
+ * whose components are all above the Latin1 range are not run-time locale
+ * dependent, and have already been folded by the time this function is
+ * called.)
*
* This is as good a place as any to discuss the design of handling these
* multi-character fold sequences. It's been wrong in Perl for a very long
* time. There are three code points in Unicode whose multi-character folds
* were long ago discovered to mess things up. The previous designs for
* dealing with these involved assigning a special node for them. This
- * approach doesn't work, as evidenced by this example:
+ * approach doesn't always work, as evidenced by this example:
* "\xDFs" =~ /s\xDF/ui # Used to fail before these patches
- * Both these fold to "sss", but if the pattern is parsed to create a node that
+ * Both sides fold to "sss", but if the pattern is parsed to create a node that
* would match just the \xDF, it won't be able to handle the case where a
* successful match would have to cross the node's boundary. The new approach
* that hopefully generally solves the problem generates an EXACTFU_SS node
- * that is "sss".
+ * that is "sss" in this case.
*
* It turns out that there are problems with all multi-character folds, and not
* just these three. Now the code is general, for all such cases. The
* approach taken is:
* 1) This routine examines each EXACTFish node that could contain multi-
- * character fold sequences. It returns in *min_subtract how much to
- * subtract from the the actual length of the string to get a real minimum
- * match length; it is 0 if there are no multi-char folds. This delta is
- * used by the caller to adjust the min length of the match, and the delta
- * between min and max, so that the optimizer doesn't reject these
- * possibilities based on size constraints.
+ * character folded sequences. Since a single character can fold into
+ * such a sequence, the minimum match length for this node is less than
+ * the number of characters in the node. This routine returns in
+ * *min_subtract how many characters to subtract from the the actual
+ * length of the string to get a real minimum match length; it is 0 if
+ * there are no multi-char foldeds. This delta is used by the caller to
+ * adjust the min length of the match, and the delta between min and max,
+ * so that the optimizer doesn't reject these possibilities based on size
+ * constraints.
* 2) For the sequence involving the Sharp s (\xDF), the node type EXACTFU_SS
* is used for an EXACTFU node that contains at least one "ss" sequence in
* it. For non-UTF-8 patterns and strings, this is the only case where
* EXACTFU node without UTF-8 involvement doesn't have to concern itself
* with length changes, and so can be processed faster. regexec.c takes
* advantage of this. Generally, an EXACTFish node that is in UTF-8 is
- * pre-folded by regcomp.c. This saves effort in regex matching.
- * However, the pre-folding isn't done for non-UTF8 patterns because the
- * fold of the MICRO SIGN requires UTF-8, and we don't want to slow things
- * down by forcing the pattern into UTF8 unless necessary. Also what
- * EXACTF and EXACTFL nodes fold to isn't known until runtime. The fold
+ * pre-folded by regcomp.c (except EXACTFL, some of whose folds aren't
+ * known until runtime). This saves effort in regex matching. However,
+ * the pre-folding isn't done for non-UTF8 patterns because the fold of
+ * the MICRO SIGN requires UTF-8, and we don't want to slow things down by
+ * forcing the pattern into UTF8 unless necessary. Also what EXACTF (and,
+ * again, EXACTFL) nodes fold to isn't known until runtime. The fold
* possibilities for the non-UTF8 patterns are quite simple, except for
* the sharp s. All the ones that don't involve a UTF-8 target string are
* members of a fold-pair, and arrays are set up for all of them so that
* this file makes sure that in EXACTFU nodes, the sharp s gets folded to
* 'ss', even if the pattern isn't UTF-8. This avoids the issues
* described in the next item.
- * 3) A problem remains for the sharp s in EXACTF and EXACTFA nodes when the
- * pattern isn't in UTF-8. (BTW, there cannot be an EXACTF node with a
- * UTF-8 pattern.) An assumption that the optimizer part of regexec.c
- * (probably unwittingly, in Perl_regexec_flags()) makes is that a
- * character in the pattern corresponds to at most a single character in
- * the target string. (And I do mean character, and not byte here, unlike
- * other parts of the documentation that have never been updated to
- * account for multibyte Unicode.) sharp s in EXACTF nodes can match the
- * two character string 'ss'; in EXACTFA nodes it can match
- * "\x{17F}\x{17F}". These violate the assumption, and they are the only
- * instances where it is violated. I'm reluctant to try to change the
- * assumption, as the code involved is impenetrable to me (khw), so
- * instead the code here punts. This routine examines (when the pattern
- * isn't UTF-8) EXACTF and EXACTFA nodes for the sharp s, and returns a
- * boolean indicating whether or not the node contains a sharp s. When it
- * is true, the caller sets a flag that later causes the optimizer in this
- * file to not set values for the floating and fixed string lengths, and
- * thus avoids the optimizer code in regexec.c that makes the invalid
+ * 3) A problem remains for unfolded multi-char folds. (These occur when the
+ * validity of the fold won't be known until runtime, and so must remain
+ * unfolded for now. This happens for the sharp s in EXACTF and EXACTFA
+ * nodes when the pattern isn't in UTF-8. (Note, BTW, that there cannot
+ * be an EXACTF node with a UTF-8 pattern.) They also occur for various
+ * folds in EXACTFL nodes, regardless of the UTF-ness of the pattern.)
+ * The reason this is a problem is that the optimizer part of regexec.c
+ * (probably unwittingly, in Perl_regexec_flags()) makes an assumption
+ * that a character in the pattern corresponds to at most a single
+ * character in the target string. (And I do mean character, and not byte
+ * here, unlike other parts of the documentation that have never been
+ * updated to account for multibyte Unicode.) sharp s in EXACTF and
+ * EXACTFL nodes can match the two character string 'ss'; in EXACTFA nodes
+ * it can match "\x{17F}\x{17F}". These, along with other ones in EXACTFL
+ * nodes, violate the assumption, and they are the only instances where it
+ * is violated. I'm reluctant to try to change the assumption, as the
+ * code involved is impenetrable to me (khw), so instead the code here
+ * punts. This routine examines EXACTFL nodes, and (when the pattern
+ * isn't UTF-8) EXACTF and EXACTFA for such unfolded folds, and returns a
+ * boolean indicating whether or not the node contains such a fold. When
+ * it is true, the caller sets a flag that later causes the optimizer in
+ * this file to not set values for the floating and fixed string lengths,
+ * and thus avoids the optimizer code in regexec.c that makes the invalid
* assumption. Thus, there is no optimization based on string lengths for
- * non-UTF8-pattern EXACTF and EXACTFA nodes that contain the sharp s.
- * (The reason the assumption is wrong only in these two cases is that all
- * other non-UTF-8 folds are 1-1; and, for UTF-8 patterns, we pre-fold all
- * other folds to their expanded versions. We can't prefold sharp s to
- * 'ss' in EXACTF nodes because we don't know at compile time if it
- * actually matches 'ss' or not. It will match iff the target string is
- * in UTF-8, unlike the EXACTFU nodes, where it always matches; and
- * EXACTFA and EXACTFL where it never does. In an EXACTFA node in a UTF-8
- * pattern, sharp s is folded to "\x{17F}\x{17F}, avoiding the problem;
- * but in a non-UTF8 pattern, folding it to that above-Latin1 string would
- * require the pattern to be forced into UTF-8, the overhead of which we
- * want to avoid.)
+ * EXACTFL nodes that contain these few folds, nor for non-UTF8-pattern
+ * EXACTF and EXACTFA nodes that contain the sharp s. (The reason the
+ * assumption is wrong only in these cases is that all other non-UTF-8
+ * folds are 1-1; and, for UTF-8 patterns, we pre-fold all other folds to
+ * their expanded versions. (Again, we can't prefold sharp s to 'ss' in
+ * EXACTF nodes because we don't know at compile time if it actually
+ * matches 'ss' or not. For EXACTF nodes it will match iff the target
+ * string is in UTF-8. This is in contrast to EXACTFU nodes, where it
+ * always matches; and EXACTFA where it never does. In an EXACTFA node in
+ * a UTF-8 pattern, sharp s is folded to "\x{17F}\x{17F}, avoiding the
+ * problem; but in a non-UTF8 pattern, folding it to that above-Latin1
+ * string would require the pattern to be forced into UTF-8, the overhead
+ * of which we want to avoid. Similarly the unfolded multi-char folds in
+ * EXACTFL nodes will match iff the locale at the time of match is a UTF-8
+ * locale.)
*
* Similarly, the code that generates tries doesn't currently handle
* not-already-folded multi-char folds, and it looks like a pain to change
* using /iaa matching will be doing so almost entirely with ASCII
* strings, so this should rarely be encountered in practice */
-#define JOIN_EXACT(scan,min_subtract,has_exactf_sharp_s, flags) \
+#define JOIN_EXACT(scan,min_subtract,unfolded_multi_char, flags) \
if (PL_regkind[OP(scan)] == EXACT) \
- join_exact(pRExC_state,(scan),(min_subtract),has_exactf_sharp_s, (flags),NULL,depth+1)
+ join_exact(pRExC_state,(scan),(min_subtract),unfolded_multi_char, (flags),NULL,depth+1)
STATIC U32
-S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, UV *min_subtract, bool *has_exactf_sharp_s, U32 flags,regnode *val, U32 depth) {
+S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan,
+ UV *min_subtract, bool *unfolded_multi_char,
+ U32 flags,regnode *val, U32 depth)
+{
/* Merge several consecutive EXACTish nodes into one. */
regnode *n = regnext(scan);
U32 stringok = 1;
&& NEXT_OFF(n)
&& NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX)
{
-
+
if (OP(n) == TAIL || n > next)
stringok = 0;
if (PL_regkind[OP(n)] == NOTHING) {
const unsigned int oldl = STR_LEN(scan);
regnode * const nnext = regnext(n);
- /* XXX I (khw) kind of doubt that this works on platforms where
- * U8_MAX is above 255 because of lots of other assumptions */
+ /* XXX I (khw) kind of doubt that this works on platforms (should
+ * Perl ever run on one) where U8_MAX is above 255 because of lots
+ * of other assumptions */
/* Don't join if the sum can't fit into a single node */
if (oldl + STR_LEN(n) > U8_MAX)
break;
-
+
DEBUG_PEEP("merg",n,depth);
merged++;
}
*min_subtract = 0;
- *has_exactf_sharp_s = FALSE;
+ *unfolded_multi_char = FALSE;
/* Here, all the adjacent mergeable EXACTish nodes have been merged. We
* can now analyze for sequences of problematic code points. (Prior to
* hence missed). The sequences only happen in folding, hence for any
* non-EXACT EXACTish node */
if (OP(scan) != EXACT) {
- const U8 * const s0 = (U8*) STRING(scan);
- const U8 * s = s0;
- const U8 * const s_end = s0 + STR_LEN(scan);
+ U8* s0 = (U8*) STRING(scan);
+ U8* s = s0;
+ U8* s_end = s0 + STR_LEN(scan);
+
+ int total_count_delta = 0; /* Total delta number of characters that
+ multi-char folds expand to */
/* One pass is made over the node's string looking for all the
- * possibilities. to avoid some tests in the loop, there are two main
+ * possibilities. To avoid some tests in the loop, there are two main
* cases, for UTF-8 patterns (which can't have EXACTF nodes) and
* non-UTF-8 */
if (UTF) {
+ U8* folded = NULL;
+
+ if (OP(scan) == EXACTFL) {
+ U8 *d;
+
+ /* An EXACTFL node would already have been changed to another
+ * node type unless there is at least one character in it that
+ * is problematic; likely a character whose fold definition
+ * won't be known until runtime, and so has yet to be folded.
+ * For all but the UTF-8 locale, folds are 1-1 in length, but
+ * to handle the UTF-8 case, we need to create a temporary
+ * folded copy using UTF-8 locale rules in order to analyze it.
+ * This is because our macros that look to see if a sequence is
+ * a multi-char fold assume everything is folded (otherwise the
+ * tests in those macros would be too complicated and slow).
+ * Note that here, the non-problematic folds will have already
+ * been done, so we can just copy such characters. We actually
+ * don't completely fold the EXACTFL string. We skip the
+ * unfolded multi-char folds, as that would just create work
+ * below to figure out the size they already are */
+
+ Newx(folded, UTF8_MAX_FOLD_CHAR_EXPAND * STR_LEN(scan) + 1, U8);
+ d = folded;
+ while (s < s_end) {
+ STRLEN s_len = UTF8SKIP(s);
+ if (! is_PROBLEMATIC_LOCALE_FOLD_utf8(s)) {
+ Copy(s, d, s_len, U8);
+ d += s_len;
+ }
+ else if (is_FOLDS_TO_MULTI_utf8(s)) {
+ *unfolded_multi_char = TRUE;
+ Copy(s, d, s_len, U8);
+ d += s_len;
+ }
+ else if (isASCII(*s)) {
+ *(d++) = toFOLD(*s);
+ }
+ else {
+ STRLEN len;
+ _to_utf8_fold_flags(s, d, &len, FOLD_FLAGS_FULL);
+ d += len;
+ }
+ s += s_len;
+ }
+
+ /* Point the remainder of the routine to look at our temporary
+ * folded copy */
+ s = folded;
+ s_end = d;
+ } /* End of creating folded copy of EXACTFL string */
/* Examine the string for a multi-character fold sequence. UTF-8
* patterns have all characters pre-folded by the time this code is
while (s < s_end - 1) /* Can stop 1 before the end, as minimum
length sequence we are looking for is 2 */
{
- int count = 0;
- int len = is_MULTI_CHAR_FOLD_utf8_safe(s, s_end);
+ int count = 0; /* How many characters in a multi-char fold */
+ int len = is_MULTI_CHAR_FOLD_utf8(s);
if (! len) { /* Not a multi-char fold: get next char */
s += UTF8SKIP(s);
continue;
}
- /* Nodes with 'ss' require special handling, except for EXACTFL
- * and EXACTFA-ish for which there is no multi-char fold to
- * this */
+ /* Nodes with 'ss' require special handling, except for
+ * EXACTFA-ish for which there is no multi-char fold to this */
if (len == 2 && *s == 's' && *(s+1) == 's'
- && OP(scan) != EXACTFL
&& OP(scan) != EXACTFA
&& OP(scan) != EXACTFA_NO_TRIE)
{
count = 2;
- OP(scan) = EXACTFU_SS;
+ if (OP(scan) != EXACTFL) {
+ OP(scan) = EXACTFU_SS;
+ }
s += 2;
}
else { /* Here is a generic multi-char fold. */
- const U8* multi_end = s + len;
-
- /* Count how many characters in it. In the case of /l and
- * /aa, no folds which contain ASCII code points are
- * allowed, so check for those, and skip if found. (In
- * EXACTFL, no folds are allowed to any Latin1 code point,
- * not just ASCII. But there aren't any of these
- * currently, nor ever likely, so don't take the time to
- * test for them. The code that generates the
- * is_MULTI_foo() macros croaks should one actually get put
- * into Unicode .) */
- if (OP(scan) != EXACTFL
- && OP(scan) != EXACTFA
- && OP(scan) != EXACTFA_NO_TRIE)
- {
+ U8* multi_end = s + len;
+
+ /* Count how many characters in it. In the case of /aa, no
+ * folds which contain ASCII code points are allowed, so
+ * check for those, and skip if found. */
+ if (OP(scan) != EXACTFA && OP(scan) != EXACTFA_NO_TRIE) {
count = utf8_length(s, multi_end);
s = multi_end;
}
/* The delta is how long the sequence is minus 1 (1 is how long
* the character that folds to the sequence is) */
- *min_subtract += count - 1;
- next_iteration: ;
+ total_count_delta += count - 1;
+ next_iteration: ;
}
+
+ /* We created a temporary folded copy of the string in EXACTFL
+ * nodes. Therefore we need to be sure it doesn't go below zero,
+ * as the real string could be shorter */
+ if (OP(scan) == EXACTFL) {
+ int total_chars = utf8_length((U8*) STRING(scan),
+ (U8*) STRING(scan) + STR_LEN(scan));
+ if (total_count_delta > total_chars) {
+ total_count_delta = total_chars;
+ }
+ }
+
+ *min_subtract += total_count_delta;
+ Safefree(folded);
}
else if (OP(scan) == EXACTFA) {
while (s < s_end) {
if (*s == LATIN_SMALL_LETTER_SHARP_S) {
OP(scan) = EXACTFA_NO_TRIE;
- *has_exactf_sharp_s = TRUE;
+ *unfolded_multi_char = TRUE;
break;
}
s++;
continue;
}
}
- else if (OP(scan) != EXACTFL) {
+ else {
- /* Non-UTF-8 pattern, not EXACTFA nor EXACTFL node. Look for the
- * multi-char folds that are all Latin1. (This code knows that
- * there are no current multi-char folds possible with EXACTFL,
- * relying on fold_grind.t to catch any errors if the very unlikely
- * event happens that some get added in future Unicode versions.)
- * As explained in the comments preceding this function, we look
- * also for the sharp s in EXACTF nodes; it can be in the final
- * position. Otherwise we can stop looking 1 byte earlier because
- * have to find at least two characters for a multi-fold */
- const U8* upper = (OP(scan) == EXACTF) ? s_end : s_end -1;
+ /* Non-UTF-8 pattern, not EXACTFA node. Look for the multi-char
+ * folds that are all Latin1. As explained in the comments
+ * preceding this function, we look also for the sharp s in EXACTF
+ * and EXACTFL nodes; it can be in the final position. Otherwise
+ * we can stop looking 1 byte earlier because have to find at least
+ * two characters for a multi-fold */
+ const U8* upper = (OP(scan) == EXACTF || OP(scan) == EXACTFL)
+ ? s_end
+ : s_end -1;
while (s < upper) {
- int len = is_MULTI_CHAR_FOLD_latin1_safe(s, s_end);
+ int len = is_MULTI_CHAR_FOLD_latin1(s);
if (! len) { /* Not a multi-char fold. */
- if (*s == LATIN_SMALL_LETTER_SHARP_S && OP(scan) == EXACTF)
+ if (*s == LATIN_SMALL_LETTER_SHARP_S
+ && (OP(scan) == EXACTF || OP(scan) == EXACTFL))
{
- *has_exactf_sharp_s = TRUE;
+ *unfolded_multi_char = TRUE;
}
s++;
continue;
* changed so that a sharp s in the string can match this
* ss in the pattern, but they remain EXACTF nodes, as they
* won't match this unless the target string is is UTF-8,
- * which we don't know until runtime */
- if (OP(scan) != EXACTF) {
+ * which we don't know until runtime. EXACTFL nodes can't
+ * transform into EXACTFU nodes */
+ if (OP(scan) != EXACTF && OP(scan) != EXACTFL) {
OP(scan) = EXACTFU_SS;
}
}
regnode *last; /* last node to process in this frame */
regnode *next; /* next node to process when last is reached */
struct scan_frame *prev; /*previous frame*/
+ U32 prev_recursed_depth;
I32 stop; /* what stopparen do we use */
} scan_frame;
regnode *last,
scan_data_t *data,
I32 stopparen,
- U8* recursed,
+ U32 recursed_depth,
regnode_ssc *and_withp,
U32 flags, U32 depth)
/* scanp: Start here (read-write). */
#ifdef DEBUGGING
StructCopy(&zero_scan_data, &data_fake, scan_data_t);
#endif
-
if ( depth == 0 ) {
while (first_non_open && OP(first_non_open) == OPEN)
first_non_open=regnext(first_non_open);
UV min_subtract = 0; /* How mmany chars to subtract from the minimum
node length to get a real minimum (because
the folded version may be shorter) */
- bool has_exactf_sharp_s = FALSE;
+ bool unfolded_multi_char = FALSE;
/* Peephole optimizer: */
- DEBUG_STUDYDATA("Peep:", data,depth);
- DEBUG_PEEP("Peep",scan,depth);
+ DEBUG_OPTIMISE_MORE_r(
+ {
+ PerlIO_printf(Perl_debug_log,
+ "%*sstudy_chunk stopparen=%ld depth=%lu recursed_depth=%lu ",
+ ((int) depth*2), "", (long)stopparen,
+ (unsigned long)depth, (unsigned long)recursed_depth);
+ if (recursed_depth) {
+ U32 i;
+ U32 j;
+ for ( j = 0 ; j < recursed_depth ; j++ ) {
+ PerlIO_printf(Perl_debug_log,"[");
+ for ( i = 0 ; i < (U32)RExC_npar ; i++ )
+ PerlIO_printf(Perl_debug_log,"%d",
+ PAREN_TEST(RExC_study_chunk_recursed +
+ (j * RExC_study_chunk_recursed_bytes), i)
+ ? 1 : 0
+ );
+ PerlIO_printf(Perl_debug_log,"]");
+ }
+ }
+ PerlIO_printf(Perl_debug_log,"\n");
+ }
+ );
+ DEBUG_STUDYDATA("Peep:", data, depth);
+ DEBUG_PEEP("Peep", scan, depth);
+
/* Its not clear to khw or hv why this is done here, and not in the
* clauses that deal with EXACT nodes. khw's guess is that it's
* because of a previous design */
- JOIN_EXACT(scan,&min_subtract, &has_exactf_sharp_s, 0);
+ JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0);
/* Follow the next-chain of the current node and optimize
away all the NOTHINGs from it. */
|| OP(scan) == IFTHEN) {
next = regnext(scan);
code = OP(scan);
- /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
+ /* demq: the op(next)==code check is to see if we have
+ * "branch-branch" AFAICT */
if (OP(next) == code || code == IFTHEN) {
/* NOTE - There is similar code to this block below for
regnode * const startbranch=scan;
if (flags & SCF_DO_SUBSTR)
- SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
- if (flags & SCF_DO_STCLASS)
+ SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge
+ strings after
+ this. */
+ if (flags & SCF_DO_STCLASS)
ssc_init_zero(pRExC_state, &accum);
while (OP(scan) == code) {
f |= SCF_WHILEM_VISITED_POS;
/* we suppose the run is continuous, last=next...*/
- minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
- next, &data_fake,
- stopparen, recursed, NULL, f,depth+1);
+ minnext = study_chunk(pRExC_state, &scan, minlenp,
+ &deltanext, next, &data_fake, stopparen,
+ recursed_depth, NULL, f,depth+1);
if (min1 > minnext)
min1 = minnext;
if (deltanext == SSize_t_MAX) {
if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
pars++;
if (data_fake.flags & SCF_SEEN_ACCEPT) {
- if ( stopmin > minnext)
+ if ( stopmin > minnext)
stopmin = min + min1;
flags &= ~SCF_DO_SUBSTR;
if (data)
}
}
- if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
+ if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch )
+ == BRANCH )
+ {
/* demq.
Assuming this was/is a branch we are dealing with: 'scan'
'BRANCH EXACT; BRANCH EXACT; BRANCH X'
becomes BRANCH TRIE; BRANCH X;
- There is an additional case, that being where there is a
+ There is an additional case, that being where there is a
common prefix, which gets split out into an EXACT like node
preceding the TRIE node.
U32 count=0;
#ifdef DEBUGGING
- SV * const mysv = sv_newmortal(); /* for dumping */
+ SV * const mysv = sv_newmortal(); /* for dumping */
#endif
/* var tail is used because there may be a TAIL
regop in the way. Ie, the exacts will point to the
tail = regnext( tail );
}
-
+
DEBUG_TRIE_COMPILE_r({
regprop(RExC_rx, mysv, tail );
PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
- (int)depth * 2 + 2, "",
- "Looking for TRIE'able sequences. Tail node is: ",
- SvPV_nolen_const( mysv )
+ (int)depth * 2 + 2, "",
+ "Looking for TRIE'able sequences. Tail node is: ",
+ SvPV_nolen_const( mysv )
);
});
-
+
/*
Step through the branches
}
PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d,tt==%s,nt==%s,nnt==%s)\n",
REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur),
- PL_reg_name[trietype], PL_reg_name[noper_trietype], PL_reg_name[noper_next_trietype]
+ PL_reg_name[trietype], PL_reg_name[noper_trietype], PL_reg_name[noper_next_trietype]
);
});
* so we leave it in for now. */
if ( trietype && trietype != NOTHING )
make_trie( pRExC_state,
- startbranch, first, cur, tail, count,
- trietype, depth+1 );
+ startbranch, first, cur, tail,
+ count, trietype, depth+1 );
last = NULL; /* note: we clear/update
first, trietype etc below,
so we dont do it here */
DEBUG_TRIE_COMPILE_r({
regprop(RExC_rx, mysv, cur);
PerlIO_printf( Perl_debug_log,
- "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
+ "%*s- %s (%d) <SCAN FINISHED>\n",
+ (int)depth * 2 + 2,
"", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
});
/* the last branch of the sequence was part of
* a trie, so we have to construct it here
* outside of the loop */
- made= make_trie( pRExC_state, startbranch, first, scan, tail, count, trietype, depth+1 );
+ made= make_trie( pRExC_state, startbranch,
+ first, scan, tail, count,
+ trietype, depth+1 );
#ifdef TRIE_STUDY_OPT
if ( ((made == MADE_EXACT_TRIE &&
startbranch == first)
if ( startbranch == first
&& scan == tail )
{
- RExC_seen &=~REG_TOP_LEVEL_BRANCHES;
+ RExC_seen &=~REG_TOP_LEVEL_BRANCHES_SEEN;
}
}
#endif
}
} /* end if ( last) */
} /* TRIE_MAXBUF is non zero */
-
+
} /* do trie */
-
+
}
else if ( code == BRANCHJ ) { /* single branch is optimized. */
scan = NEXTOPER(NEXTOPER(scan));
I32 paren;
regnode *start;
regnode *end;
+ U32 my_recursed_depth= recursed_depth;
if (OP(scan) != SUSPEND) {
- /* set the pointer */
+ /* set the pointer */
if (OP(scan) == GOSUB) {
paren = ARG(scan);
RExC_recurse[ARG2L(scan)] = scan;
start = RExC_rxi->program + 1;
end = RExC_opend;
}
- if (!recursed) {
- Newxz(recursed, (((RExC_npar)>>3) +1), U8);
- SAVEFREEPV(recursed);
- }
- if (!PAREN_TEST(recursed,paren+1)) {
- PAREN_SET(recursed,paren+1);
+ if (!recursed_depth
+ ||
+ !PAREN_TEST(RExC_study_chunk_recursed + ((recursed_depth-1) * RExC_study_chunk_recursed_bytes), paren)
+ ) {
+ if (!recursed_depth) {
+ Zero(RExC_study_chunk_recursed, RExC_study_chunk_recursed_bytes, U8);
+ } else {
+ Copy(RExC_study_chunk_recursed + ((recursed_depth-1) * RExC_study_chunk_recursed_bytes),
+ RExC_study_chunk_recursed + (recursed_depth * RExC_study_chunk_recursed_bytes),
+ RExC_study_chunk_recursed_bytes, U8);
+ }
+ /* we havent recursed into this paren yet, so recurse into it */
+ DEBUG_STUDYDATA("set:", data,depth);
+ PAREN_SET(RExC_study_chunk_recursed + (recursed_depth * RExC_study_chunk_recursed_bytes), paren);
+ my_recursed_depth= recursed_depth + 1;
Newx(newframe,1,scan_frame);
} else {
+ DEBUG_STUDYDATA("inf:", data,depth);
+ /* some form of infinite recursion, assume infinite length
+ * */
if (flags & SCF_DO_SUBSTR) {
SCAN_COMMIT(pRExC_state,data,minlenp);
data->longest = &(data->longest_float);
newframe->last = last;
newframe->stop = stopparen;
newframe->prev = frame;
+ newframe->prev_recursed_depth = recursed_depth;
+
+ DEBUG_STUDYDATA("frame-new:",data,depth);
+ DEBUG_PEEP("fnew", scan, depth);
frame = newframe;
scan = start;
stopparen = paren;
last = end;
+ depth = depth + 1;
+ recursed_depth= my_recursed_depth;
continue;
}
mg_find(sv, PERL_MAGIC_utf8) : NULL;
if (mg && mg->mg_len >= 0)
mg->mg_len += utf8_length((U8*)STRING(scan),
- (U8*)STRING(scan)+STR_LEN(scan));
+ (U8*)STRING(scan)+STR_LEN(scan));
}
data->last_end = data->pos_min + l;
data->pos_min += l; /* As in the first entry. */
else if (flags & SCF_DO_STCLASS_OR) {
ssc_add_cp(data->start_class, uc);
ssc_and(pRExC_state, data->start_class, and_withp);
+
+ /* See commit msg 749e076fceedeb708a624933726e7989f2302f6a */
+ ANYOF_FLAGS(data->start_class) &= ~ANYOF_EMPTY_STRING;
}
flags &= ~SCF_DO_STCLASS;
}
uc = utf8_to_uvchr_buf(s, s + l, NULL);
l = utf8_length(s, s + l);
}
- if (has_exactf_sharp_s) {
- RExC_seen |= REG_SEEN_EXACTF_SHARP_S;
+ if (unfolded_multi_char) {
+ RExC_seen |= REG_UNFOLDED_MULTI_SEEN;
}
min += l - min_subtract;
assert (min >= 0);
}
if (OP(scan) == EXACTFL) {
if (flags & SCF_DO_STCLASS_AND) {
- ssc_flags_and(data->start_class,
- ANYOF_LOCALE|ANYOF_LOC_FOLD);
+ ssc_flags_and(data->start_class, ANYOF_LOCALE);
}
else if (flags & SCF_DO_STCLASS_OR) {
- ANYOF_FLAGS(data->start_class)
- |= ANYOF_LOCALE|ANYOF_LOC_FOLD;
+ ANYOF_FLAGS(data->start_class) |= ANYOF_LOCALE;
}
/* We don't know what the folds are; it could be anything. XXX
* range can participate */
if (OP(scan) == EXACTFA) {
_invlist_union_complement_2nd(EXACTF_invlist,
- PL_Posix_ptrs[_CC_ASCII],
+ PL_XPosix_ptrs[_CC_ASCII],
&EXACTF_invlist);
}
else {
else if (flags & SCF_DO_STCLASS_OR) {
ssc_union(data->start_class, EXACTF_invlist, FALSE);
ssc_and(pRExC_state, data->start_class, and_withp);
+
+ /* See commit msg 749e076fceedeb708a624933726e7989f2302f6a */
+ ANYOF_FLAGS(data->start_class) &= ~ANYOF_EMPTY_STRING;
}
flags &= ~SCF_DO_STCLASS;
SvREFCNT_dec(EXACTF_invlist);
is_inf = is_inf_internal = 1;
scan = regnext(scan);
if (flags & SCF_DO_SUBSTR) {
- SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
+ SCAN_COMMIT(pRExC_state, data, minlenp);
+ /* Cannot extend fixed substrings */
data->longest = &(data->longest_float);
}
goto optimize_curly_tail;
next_is_eval = (OP(scan) == EVAL);
do_curly:
if (flags & SCF_DO_SUBSTR) {
- if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
+ if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp);
+ /* Cannot extend fixed substrings */
pos_before = data->pos_min;
}
if (data) {
f &= ~SCF_WHILEM_VISITED_POS;
/* This will finish on WHILEM, setting scan, or on NULL: */
- minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
- last, data, stopparen, recursed, NULL,
- (mincount == 0
- ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
+ minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
+ last, data, stopparen, recursed_depth, NULL,
+ (mincount == 0
+ ? (f & ~SCF_DO_SUBSTR)
+ : f)
+ ,depth+1);
if (flags & SCF_DO_STCLASS)
data->start_class = oclass;
flags &= ~SCF_DO_STCLASS_AND;
StructCopy(&this_class, data->start_class, regnode_ssc);
flags |= SCF_DO_STCLASS_OR;
+ ANYOF_FLAGS(data->start_class) |= ANYOF_EMPTY_STRING;
}
} else { /* Non-zero len */
if (flags & SCF_DO_STCLASS_OR) {
&& (next_is_eval || !(mincount == 0 && maxcount == 1))
&& (minnext == 0) && (deltanext == 0)
&& data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
- && maxcount <= REG_INFTY/3) /* Complement check for big count */
+ && maxcount <= REG_INFTY/3) /* Complement check for big
+ count */
{
/* Fatal warnings may leak the regexp without this: */
SAVEFREESV(RExC_rx_sv);
ckWARNreg(RExC_parse,
- "Quantifier unexpected on zero-length expression");
+ "Quantifier unexpected on zero-length expression");
(void)ReREFCNT_inc(RExC_rx_sv);
}
min += minnext * mincount;
is_inf_internal |= deltanext == SSize_t_MAX
- || (maxcount == REG_INFTY && minnext + deltanext > 0);
+ || (maxcount == REG_INFTY && minnext + deltanext > 0);
is_inf |= is_inf_internal;
- if (is_inf)
+ if (is_inf) {
delta = SSize_t_MAX;
- else
- delta += (minnext + deltanext) * maxcount - minnext * mincount;
-
+ } else {
+ delta += (minnext + deltanext) * maxcount
+ - minnext * mincount;
+ }
/* Try powerful optimization CURLYX => CURLYN. */
if ( OP(oscan) == CURLYX && data
&& data->flags & SF_IN_PAR
&& !(data->flags & SF_HAS_EVAL)
&& !deltanext /* atom is fixed width */
&& minnext != 0 /* CURLYM can't handle zero width */
- && ! (RExC_seen & REG_SEEN_EXACTF_SHARP_S) /* Nor \xDF */
+
+ /* Nor characters whose fold at run-time may be
+ * multi-character */
+ && ! (RExC_seen & REG_UNFOLDED_MULTI_SEEN)
) {
/* XXXX How to optimize if data == 0? */
/* Optimize to a simpler form. */
#endif
/* Optimize again: */
study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
- NULL, stopparen, recursed, NULL, 0,depth+1);
+ NULL, stopparen, recursed_depth, NULL, 0,depth+1);
}
else
oscan->flags = 0;
SV *last_str = NULL;
int counted = mincount != 0;
- if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
+ if (data->last_end > 0 && mincount != 0) { /* Ends with a
+ string. */
SSize_t b = pos_before >= data->last_start_min
? pos_before : data->last_start_min;
STRLEN l;
if (mincount > 1) {
SvGROW(last_str, (mincount * l) + 1);
repeatcpy(SvPVX(last_str) + l,
- SvPVX_const(last_str), l, mincount - 1);
+ SvPVX_const(last_str), l,
+ mincount - 1);
SvCUR_set(last_str, SvCUR(last_str) * mincount);
/* Add additional parts. */
SvCUR_set(data->last_found,
(UV)(-counted * deltanext + (minnext + deltanext) * maxcount
- minnext * mincount), (UV)(SSize_t_MAX - data->pos_delta));
#endif
- if (deltanext == SSize_t_MAX ||
- -counted * deltanext + (minnext + deltanext) * maxcount - minnext * mincount >= SSize_t_MAX - data->pos_delta)
+ if (deltanext == SSize_t_MAX
+ || -counted * deltanext + (minnext + deltanext) * maxcount - minnext * mincount >= SSize_t_MAX - data->pos_delta)
data->pos_delta = SSize_t_MAX;
else
data->pos_delta += - counted * deltanext +
case REF:
case CLUMP:
if (flags & SCF_DO_SUBSTR) {
- SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
+ SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect
+ anything... */
data->longest = &(data->longest_float);
}
is_inf = is_inf_internal = 1;
PL_XPosix_ptrs[_CC_VERTSPACE],
FALSE);
ssc_and(pRExC_state, data->start_class, and_withp);
+
+ /* See commit msg for
+ * 749e076fceedeb708a624933726e7989f2302f6a */
+ ANYOF_FLAGS(data->start_class) &= ~ANYOF_EMPTY_STRING;
}
flags &= ~SCF_DO_STCLASS;
}
min++;
delta++; /* Because of the 2 char string cr-lf */
if (flags & SCF_DO_SUBSTR) {
- SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
+ SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect
+ anything... */
data->pos_min += 1;
data->pos_delta += 1;
data->longest = &(data->longest_float);
if (flags & SCF_DO_STCLASS) {
bool invert = 0;
SV* my_invlist = sv_2mortal(_new_invlist(0));
- U8 classnum;
U8 namedclass;
- if (flags & SCF_DO_STCLASS_AND) {
- ANYOF_FLAGS(data->start_class) &= ~ANYOF_EMPTY_STRING;
- }
+ /* See commit msg 749e076fceedeb708a624933726e7989f2302f6a */
+ ANYOF_FLAGS(data->start_class) &= ~ANYOF_EMPTY_STRING;
/* Some of the logic below assumes that switching
locale on will only add false positives. */
default:
#ifdef DEBUGGING
- Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan));
+ Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d",
+ OP(scan));
#endif
case CANY:
case SANY:
}
break;
- case ANYOF_WARN_SUPER:
case ANYOF:
if (flags & SCF_DO_STCLASS_AND)
ssc_and(pRExC_state, data->start_class,
/* FALL THROUGH */
case POSIXL:
- classnum = FLAGS(scan);
- namedclass = classnum_to_namedclass(classnum) + invert;
+ namedclass = classnum_to_namedclass(FLAGS(scan)) + invert;
if (flags & SCF_DO_STCLASS_AND) {
- bool was_there = ANYOF_POSIXL_TEST(data->start_class,
- namedclass);
+ bool was_there = cBOOL(
+ ANYOF_POSIXL_TEST(data->start_class,
+ namedclass));
ANYOF_POSIXL_ZERO(data->start_class);
if (was_there) { /* Do an AND */
ANYOF_POSIXL_SET(data->start_class, namedclass);
invert = 1;
/* FALL THROUGH */
case POSIXA:
- classnum = FLAGS(scan);
- my_invlist = PL_Posix_ptrs[classnum];
+ if (FLAGS(scan) == _CC_ASCII) {
+ my_invlist = PL_XPosix_ptrs[_CC_ASCII];
+ }
+ else {
+ _invlist_intersection(PL_XPosix_ptrs[FLAGS(scan)],
+ PL_XPosix_ptrs[_CC_ASCII],
+ &my_invlist);
+ }
goto join_posix;
case NPOSIXD:
/* FALL THROUGH */
case POSIXD:
case POSIXU:
- classnum = FLAGS(scan);
-
- /* If we know all the code points that match the class, use
- * that; otherwise use the Latin1 code points, plus we have
- * to assume that it could match anything above Latin1 */
- if (PL_XPosix_ptrs[classnum]) {
- my_invlist = invlist_clone(PL_XPosix_ptrs[classnum]);
- }
- else {
- _invlist_union(PL_L1Posix_ptrs[classnum],
- PL_AboveLatin1, &my_invlist);
- }
+ my_invlist = invlist_clone(PL_XPosix_ptrs[FLAGS(scan)]);
/* NPOSIXD matches all upper Latin1 code points unless the
* target string being matched is UTF-8, which is
- * unknowable until match time */
- if (PL_regkind[OP(scan)] == NPOSIXD) {
- _invlist_union_complement_2nd(my_invlist,
- PL_Posix_ptrs[_CC_ASCII], &my_invlist);
+ * unknowable until match time. Since we are going to
+ * invert, we want to get rid of all of them so that the
+ * inversion will match all */
+ if (OP(scan) == NPOSIXD) {
+ _invlist_subtract(my_invlist, PL_UpperLatin1,
+ &my_invlist);
}
join_posix:
/*DEBUG_PARSE_MSG("opfail");*/
regprop(RExC_rx, mysv_val, upto);
- PerlIO_printf(Perl_debug_log, "~ replace with OPFAIL pointed at %s (%"IVdf") offset %"IVdf"\n",
- SvPV_nolen_const(mysv_val),
- (IV)REG_NODE_NUM(upto),
- (IV)(upto - scan)
+ PerlIO_printf(Perl_debug_log,
+ "~ replace with OPFAIL pointed at %s (%"IVdf") offset %"IVdf"\n",
+ SvPV_nolen_const(mysv_val),
+ (IV)REG_NODE_NUM(upto),
+ (IV)(upto - scan)
);
});
OP(scan) = OPFAIL;
scan= upto;
continue;
}
- if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY
+ if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY
|| OP(scan) == UNLESSM )
{
/* Negative Lookahead/lookbehind
f |= SCF_WHILEM_VISITED_POS;
next = regnext(scan);
nscan = NEXTOPER(NEXTOPER(scan));
- minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext,
- last, &data_fake, stopparen, recursed, NULL, f, depth+1);
+ minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext,
+ last, &data_fake, stopparen,
+ recursed_depth, NULL, f, depth+1);
if (scan->flags) {
if (deltanext) {
FAIL("Variable length lookbehind not implemented");
}
else if (minnext > (I32)U8_MAX) {
- FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
+ FAIL2("Lookbehind longer than %"UVuf" not implemented",
+ (UV)U8_MAX);
}
scan->flags = (U8)minnext;
}
regnode *nscan;
regnode_ssc intrnl;
int f = 0;
- /* We use SAVEFREEPV so that when the full compile
- is finished perl will clean up the allocated
+ /* We use SAVEFREEPV so that when the full compile
+ is finished perl will clean up the allocated
minlens when it's all done. This way we don't
have to worry about freeing them when we know
they wont be used, which would be a pain.
StructCopy(data, &data_fake, scan_data_t);
if ((flags & SCF_DO_SUBSTR) && data->last_found) {
f |= SCF_DO_SUBSTR;
- if (scan->flags)
+ if (scan->flags)
SCAN_COMMIT(pRExC_state, &data_fake,minlenp);
data_fake.last_found=newSVsv(data->last_found);
}
next = regnext(scan);
nscan = NEXTOPER(NEXTOPER(scan));
- *minnextp = study_chunk(pRExC_state, &nscan, minnextp, &deltanext,
- last, &data_fake, stopparen, recursed, NULL, f,depth+1);
+ *minnextp = study_chunk(pRExC_state, &nscan, minnextp,
+ &deltanext, last, &data_fake,
+ stopparen, recursed_depth, NULL,
+ f,depth+1);
if (scan->flags) {
if (deltanext) {
FAIL("Variable length lookbehind not implemented");
}
else if (*minnextp > (I32)U8_MAX) {
- FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
+ FAIL2("Lookbehind longer than %"UVuf" not implemented",
+ (UV)U8_MAX);
}
scan->flags = (U8)*minnextp;
}
RExC_rx->minlen=*minnextp;
SCAN_COMMIT(pRExC_state, &data_fake, minnextp);
SvREFCNT_dec_NN(data_fake.last_found);
-
- if ( data_fake.minlen_fixed != minlenp )
+
+ if ( data_fake.minlen_fixed != minlenp )
{
data->offset_fixed= data_fake.offset_fixed;
data->minlen_fixed= data_fake.minlen_fixed;
flags &= ~SCF_DO_STCLASS;
}
else if (OP(scan) == GPOS) {
- if (!(RExC_rx->extflags & RXf_GPOS_FLOAT) &&
- !(delta || is_inf || (data && data->pos_delta)))
+ if (!(RExC_rx->intflags & PREGf_GPOS_FLOAT) &&
+ !(delta || is_inf || (data && data->pos_delta)))
{
- if (!(RExC_rx->extflags & RXf_ANCH) && (flags & SCF_DO_SUBSTR))
- RExC_rx->extflags |= RXf_ANCH_GPOS;
+ if (!(RExC_rx->intflags & PREGf_ANCH) && (flags & SCF_DO_SUBSTR))
+ RExC_rx->intflags |= PREGf_ANCH_GPOS;
if (RExC_rx->gofs < (STRLEN)min)
RExC_rx->gofs = min;
} else {
- RExC_rx->extflags |= RXf_GPOS_FLOAT;
+ RExC_rx->intflags |= PREGf_GPOS_FLOAT;
RExC_rx->gofs = 0;
- }
+ }
}
#ifdef TRIE_STUDY_OPT
#ifdef FULL_TRIE_STUDY
regnode_ssc accum;
if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
- SCAN_COMMIT(pRExC_state, data,minlenp); /* Cannot merge strings after this. */
+ SCAN_COMMIT(pRExC_state, data,minlenp); /* Cannot merge strings
+ after this. */
if (flags & SCF_DO_STCLASS)
ssc_init_zero(pRExC_state, &accum);
-
+
if (!trie->jump) {
min1= trie->minlen;
max1= trie->maxlen;
} else {
const regnode *nextbranch= NULL;
U32 word;
-
- for ( word=1 ; word <= trie->wordcount ; word++)
+
+ for ( word=1 ; word <= trie->wordcount ; word++)
{
SSize_t deltanext=0, minnext=0, f = 0, fake;
regnode_ssc this_class;
-
+
data_fake.flags = 0;
if (data) {
data_fake.whilem_c = data->whilem_c;
}
if (flags & SCF_WHILEM_VISITED_POS)
f |= SCF_WHILEM_VISITED_POS;
-
+
if (trie->jump[word]) {
if (!nextbranch)
nextbranch = trie_node + trie->jump[0];
scan= trie_node + trie->jump[word];
/* We go from the jump point to the branch that follows
- it. Note this means we need the vestigal unused branches
- even though they arent otherwise used.
- */
- minnext = study_chunk(pRExC_state, &scan, minlenp,
- &deltanext, (regnode *)nextbranch, &data_fake,
- stopparen, recursed, NULL, f,depth+1);
+ it. Note this means we need the vestigal unused
+ branches even though they arent otherwise used. */
+ minnext = study_chunk(pRExC_state, &scan, minlenp,
+ &deltanext, (regnode *)nextbranch, &data_fake,
+ stopparen, recursed_depth, NULL, f,depth+1);
}
if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
nextbranch= regnext((regnode*)nextbranch);
-
+
if (min1 > (SSize_t)(minnext + trie->minlen))
min1 = minnext + trie->minlen;
if (deltanext == SSize_t_MAX) {
max1 = SSize_t_MAX;
} else if (max1 < (SSize_t)(minnext + deltanext + trie->maxlen))
max1 = minnext + deltanext + trie->maxlen;
-
+
if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
pars++;
if (data_fake.flags & SCF_SEEN_ACCEPT) {
- if ( stopmin > min + min1)
+ if ( stopmin > min + min1)
stopmin = min + min1;
flags &= ~SCF_DO_SUBSTR;
if (data)
else if (PL_regkind[OP(scan)] == TRIE) {
reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ];
U8*bang=NULL;
-
+
min += trie->minlen;
delta += (trie->maxlen - trie->minlen);
flags &= ~SCF_DO_STCLASS; /* xxx */
if (flags & SCF_DO_SUBSTR) {
- SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
+ SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect
+ anything... */
data->pos_min += trie->minlen;
data->pos_delta += (trie->maxlen - trie->minlen);
if (trie->maxlen != trie->minlen)
data->longest = &(data->longest_float);
}
if (trie->jump) /* no more substrings -- for now /grr*/
- flags &= ~SCF_DO_SUBSTR;
+ flags &= ~SCF_DO_SUBSTR;
}
#endif /* old or new */
#endif /* TRIE_STUDY_OPT */
/* Else: zero-length, ignore. */
scan = regnext(scan);
}
+ /* If we are exiting a recursion we can unset its recursed bit
+ * and allow ourselves to enter it again - no danger of an
+ * infinite loop there.
+ if (stopparen > -1 && recursed) {
+ DEBUG_STUDYDATA("unset:", data,depth);
+ PAREN_UNSET( recursed, stopparen);
+ }
+ */
if (frame) {
+ DEBUG_STUDYDATA("frame-end:",data,depth);
+ DEBUG_PEEP("fend", scan, depth);
+ /* restore previous context */
last = frame->last;
scan = frame->next;
stopparen = frame->stop;
+ recursed_depth = frame->prev_recursed_depth;
+ depth = depth - 1;
+
frame = frame->prev;
goto fake_study_recurse;
}
*scanp = scan;
*deltap = is_inf_internal ? SSize_t_MAX : delta;
+
if (flags & SCF_DO_SUBSTR && is_inf)
data->pos_delta = SSize_t_MAX - data->pos_min;
if (is_par > (I32)U8_MAX)
ssc_and(pRExC_state, data->start_class, and_withp);
if (flags & SCF_TRIE_RESTUDY)
data->flags |= SCF_TRIE_RESTUDY;
-
+
DEBUG_STUDYDATA("post-fin:",data,depth);
-
- return min < stopmin ? min : stopmin;
+
+ {
+ SSize_t final_minlen= min < stopmin ? min : stopmin;
+
+ if (RExC_maxlen < final_minlen + delta) {
+ RExC_maxlen = final_minlen + delta;
+ }
+
+ return final_minlen;
+ }
+ /* not-reached */
}
STATIC U32
} STMT_END
#else
#define CHECK_RESTUDY_GOTO_butfirst
-#endif
+#endif
/*
* pregcomp - compile a regular expression into internal code
* scope
*/
-#ifndef PERL_IN_XSUB_RE
+#ifndef PERL_IN_XSUB_RE
/* return the currently in-scope regex engine (or the default if none) */
if (oplist) {
assert(oplist->op_type == OP_PADAV
- || oplist->op_type == OP_RV2AV);
+ || oplist->op_type == OP_RV2AV);
oplist = oplist->op_sibling;;
}
STATIC bool
-S_setup_longest(pTHX_ RExC_state_t *pRExC_state, SV* sv_longest, SV** rx_utf8, SV** rx_substr, SSize_t* rx_end_shift,
- SSize_t lookbehind, SSize_t offset, SSize_t *minlen, STRLEN longest_length, bool eol, bool meol)
+S_setup_longest(pTHX_ RExC_state_t *pRExC_state, SV* sv_longest,
+ SV** rx_utf8, SV** rx_substr, SSize_t* rx_end_shift,
+ SSize_t lookbehind, SSize_t offset, SSize_t *minlen,
+ STRLEN longest_length, bool eol, bool meol)
{
/* This is the common code for setting up the floating and fixed length
* string data extracted from Perl_re_op_compile() below. Returns a boolean
|| (eol /* Can't have SEOL and MULTI */
&& (! meol || (RExC_flags & RXf_PMf_MULTILINE)))
)
- /* See comments for join_exact for why REG_SEEN_EXACTF_SHARP_S */
- || (RExC_seen & REG_SEEN_EXACTF_SHARP_S))
+ /* See comments for join_exact for why REG_UNFOLDED_MULTI_SEEN */
+ || (RExC_seen & REG_UNFOLDED_MULTI_SEEN))
{
return FALSE;
}
scan_data_t data;
RExC_state_t RExC_state;
RExC_state_t * const pRExC_state = &RExC_state;
-#ifdef TRIE_STUDY_OPT
+#ifdef TRIE_STUDY_OPT
int restudied = 0;
RExC_state_t copyRExC_state;
-#endif
+#endif
GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_RE_OP_COMPILE;
PL_AboveLatin1 = _new_invlist_C_array(AboveLatin1_invlist);
PL_Latin1 = _new_invlist_C_array(Latin1_invlist);
PL_UpperLatin1 = _new_invlist_C_array(UpperLatin1_invlist);
-
- PL_Posix_ptrs[_CC_ASCII] = _new_invlist_C_array(ASCII_invlist);
- PL_L1Posix_ptrs[_CC_ASCII] = _new_invlist_C_array(ASCII_invlist);
- PL_XPosix_ptrs[_CC_ASCII] = _new_invlist_C_array(ASCII_invlist);
-
- PL_L1Posix_ptrs[_CC_ALPHANUMERIC]
- = _new_invlist_C_array(L1PosixAlnum_invlist);
- PL_Posix_ptrs[_CC_ALPHANUMERIC]
- = _new_invlist_C_array(PosixAlnum_invlist);
-
- PL_L1Posix_ptrs[_CC_ALPHA]
- = _new_invlist_C_array(L1PosixAlpha_invlist);
- PL_Posix_ptrs[_CC_ALPHA] = _new_invlist_C_array(PosixAlpha_invlist);
-
- PL_Posix_ptrs[_CC_BLANK] = _new_invlist_C_array(PosixBlank_invlist);
- PL_XPosix_ptrs[_CC_BLANK] = _new_invlist_C_array(XPosixBlank_invlist);
-
- /* Cased is the same as Alpha in the ASCII range */
- PL_L1Posix_ptrs[_CC_CASED] = _new_invlist_C_array(L1Cased_invlist);
- PL_Posix_ptrs[_CC_CASED] = _new_invlist_C_array(PosixAlpha_invlist);
-
- PL_Posix_ptrs[_CC_CNTRL] = _new_invlist_C_array(PosixCntrl_invlist);
- PL_XPosix_ptrs[_CC_CNTRL] = _new_invlist_C_array(XPosixCntrl_invlist);
-
- PL_Posix_ptrs[_CC_DIGIT] = _new_invlist_C_array(PosixDigit_invlist);
- PL_L1Posix_ptrs[_CC_DIGIT] = _new_invlist_C_array(PosixDigit_invlist);
-
- PL_L1Posix_ptrs[_CC_GRAPH] = _new_invlist_C_array(L1PosixGraph_invlist);
- PL_Posix_ptrs[_CC_GRAPH] = _new_invlist_C_array(PosixGraph_invlist);
-
- PL_L1Posix_ptrs[_CC_LOWER] = _new_invlist_C_array(L1PosixLower_invlist);
- PL_Posix_ptrs[_CC_LOWER] = _new_invlist_C_array(PosixLower_invlist);
-
- PL_L1Posix_ptrs[_CC_PRINT] = _new_invlist_C_array(L1PosixPrint_invlist);
- PL_Posix_ptrs[_CC_PRINT] = _new_invlist_C_array(PosixPrint_invlist);
-
- PL_L1Posix_ptrs[_CC_PUNCT] = _new_invlist_C_array(L1PosixPunct_invlist);
- PL_Posix_ptrs[_CC_PUNCT] = _new_invlist_C_array(PosixPunct_invlist);
-
- PL_Posix_ptrs[_CC_SPACE] = _new_invlist_C_array(PerlSpace_invlist);
- PL_XPosix_ptrs[_CC_SPACE] = _new_invlist_C_array(XPerlSpace_invlist);
- PL_Posix_ptrs[_CC_PSXSPC] = _new_invlist_C_array(PosixSpace_invlist);
- PL_XPosix_ptrs[_CC_PSXSPC] = _new_invlist_C_array(XPosixSpace_invlist);
-
- PL_L1Posix_ptrs[_CC_UPPER] = _new_invlist_C_array(L1PosixUpper_invlist);
- PL_Posix_ptrs[_CC_UPPER] = _new_invlist_C_array(PosixUpper_invlist);
-
- PL_XPosix_ptrs[_CC_VERTSPACE] = _new_invlist_C_array(VertSpace_invlist);
-
- PL_Posix_ptrs[_CC_WORDCHAR] = _new_invlist_C_array(PosixWord_invlist);
- PL_L1Posix_ptrs[_CC_WORDCHAR]
- = _new_invlist_C_array(L1PosixWord_invlist);
-
- PL_Posix_ptrs[_CC_XDIGIT] = _new_invlist_C_array(PosixXDigit_invlist);
- PL_XPosix_ptrs[_CC_XDIGIT] = _new_invlist_C_array(XPosixXDigit_invlist);
-
- PL_HasMultiCharFold = _new_invlist_C_array(_Perl_Multi_Char_Folds_invlist);
+ PL_utf8_foldable = _new_invlist_C_array(_Perl_Any_Folds_invlist);
+ PL_HasMultiCharFold =
+ _new_invlist_C_array(_Perl_Folds_To_Multi_Char_invlist);
}
#endif
/* ignore the utf8ness if the pattern is 0 length */
RExC_utf8 = RExC_orig_utf8 = (plen == 0 || IN_BYTES) ? 0 : SvUTF8(pat);
- RExC_uni_semantics = 0;
+
+ /* 'use utf8' in the program indicates Unicode rules are wanted */
+ RExC_uni_semantics = (PL_hints & HINT_UTF8);
+
RExC_contains_locale = 0;
RExC_contains_i = 0;
pRExC_state->runtime_code_qr = NULL;
runtime_code = S_has_runtime_code(aTHX_ pRExC_state, exp, plen);
/* return old regex if pattern hasn't changed */
- /* XXX: note in the below we have to check the flags as well as the pattern.
+ /* XXX: note in the below we have to check the flags as well as the
+ * pattern.
*
- * Things get a touch tricky as we have to compare the utf8 flag independently
- * from the compile flags.
- */
+ * Things get a touch tricky as we have to compare the utf8 flag
+ * independently from the compile flags. */
if ( old_re
&& !recompile
if (initial_charset == REGEX_LOCALE_CHARSET) {
RExC_contains_locale = 1;
}
- else if (RExC_utf8 && initial_charset == REGEX_DEPENDS_CHARSET) {
+ else if ((RExC_utf8 || RExC_uni_semantics)
+ && initial_charset == REGEX_DEPENDS_CHARSET)
+ {
- /* Set to use unicode semantics if the pattern is in utf8 and has the
- * 'depends' charset specified, as it means unicode when utf8 */
+ /* Set to use unicode semantics if has the 'depends' charset specified,
+ * and either the pattern is in utf8 (as it means unicode when utf8),
+ * or we already know we want unicode rules */
set_regex_charset(&rx_flags, REGEX_UNICODE_CHARSET);
}
RExC_sawback = 0;
RExC_seen = 0;
+ RExC_maxlen = 0;
RExC_in_lookbehind = 0;
RExC_seen_zerolen = *exp == '^' ? -1 : 0;
RExC_extralen = 0;
RExC_paren_name_list = NULL;
#endif
RExC_recurse = NULL;
+ RExC_study_chunk_recursed = NULL;
+ RExC_study_chunk_recursed_bytes= 0;
RExC_recurse_count = 0;
pRExC_state->code_index = 0;
SvLEN_set(code_blocksv,0); /* no you can't have it, sv_clear */
DEBUG_PARSE_r({
- PerlIO_printf(Perl_debug_log,
+ PerlIO_printf(Perl_debug_log,
"Required size %"IVdf" nodes\n"
- "Starting second pass (creation)\n",
+ "Starting second pass (creation)\n",
(IV)RExC_size);
- RExC_lastnum=0;
- RExC_lastparse=NULL;
+ RExC_lastnum=0;
+ RExC_lastparse=NULL;
});
/* The first pass could have found things that force Unicode semantics */
if (RExC_whilem_seen > 15)
RExC_whilem_seen = 15;
- /* Allocate space and zero-initialize. Note, the two step process
- of zeroing when in debug mode, thus anything assigned has to
+ /* Allocate space and zero-initialize. Note, the two step process
+ of zeroing when in debug mode, thus anything assigned has to
happen after that */
rx = (REGEXP*) newSV_type(SVt_REGEXP);
r = ReANY(rx);
FAIL("Regexp out of space");
#ifdef DEBUGGING
/* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
- Zero(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode), char);
-#else
+ Zero(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode),
+ char);
+#else
/* bulk initialize base fields with 0. */
- Zero(ri, sizeof(regexp_internal), char);
+ Zero(ri, sizeof(regexp_internal), char);
#endif
/* non-zero initialization begins here */
{
bool has_p = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
- bool has_charset = (get_regex_charset(r->extflags) != REGEX_DEPENDS_CHARSET);
+ bool has_charset = (get_regex_charset(r->extflags)
+ != REGEX_DEPENDS_CHARSET);
/* The caret is output if there are any defaults: if not all the STD
* flags are set, or if no character set specifier is needed */
bool has_default =
(((r->extflags & RXf_PMf_STD_PMMOD) != RXf_PMf_STD_PMMOD)
|| ! has_charset);
- bool has_runon = ((RExC_seen & REG_SEEN_RUN_ON_COMMENT)==REG_SEEN_RUN_ON_COMMENT);
+ bool has_runon = ((RExC_seen & REG_RUN_ON_COMMENT_SEEN)
+ == REG_RUN_ON_COMMENT_SEEN);
U16 reganch = (U16)((r->extflags & RXf_PMf_STD_PMMOD)
>> RXf_PMf_STD_PMMOD_SHIFT);
const char *fptr = STD_PAT_MODS; /*"msix"*/
r->intflags = 0;
r->nparens = RExC_npar - 1; /* set early to validate backrefs */
-
- if (RExC_seen & REG_SEEN_RECURSE) {
+
+ /* setup various meta data about recursion, this all requires
+ * RExC_npar to be correctly set, and a bit later on we clear it */
+ if (RExC_seen & REG_RECURSE_SEEN) {
Newxz(RExC_open_parens, RExC_npar,regnode *);
SAVEFREEPV(RExC_open_parens);
Newxz(RExC_close_parens,RExC_npar,regnode *);
SAVEFREEPV(RExC_close_parens);
}
+ if (RExC_seen & (REG_RECURSE_SEEN | REG_GOSTART_SEEN)) {
+ /* Note, RExC_npar is 1 + the number of parens in a pattern.
+ * So its 1 if there are no parens. */
+ RExC_study_chunk_recursed_bytes= (RExC_npar >> 3) +
+ ((RExC_npar & 0x07) != 0);
+ Newx(RExC_study_chunk_recursed,
+ RExC_study_chunk_recursed_bytes * RExC_npar, U8);
+ SAVEFREEPV(RExC_study_chunk_recursed);
+ }
/* Useful during FAIL. */
#ifdef RE_TRACK_PATTERN_OFFSETS
REGC((U8)REG_MAGIC, (char*) RExC_emit++);
if (reg(pRExC_state, 0, &flags,1) == NULL) {
- ReREFCNT_dec(rx);
+ ReREFCNT_dec(rx);
Perl_croak(aTHX_ "panic: reg returned NULL to re_op_compile for generation pass, flags=%#"UVxf"", (UV) flags);
}
/* XXXX To minimize changes to RE engine we always allocate
reStudy:
r->minlen = minlen = sawlookahead = sawplus = sawopen = sawminmod = 0;
Zero(r->substrs, 1, struct reg_substr_data);
+ if (RExC_study_chunk_recursed)
+ Zero(RExC_study_chunk_recursed,
+ RExC_study_chunk_recursed_bytes * RExC_npar, U8);
#ifdef TRIE_STUDY_OPT
if (!restudied) {
} else {
U32 seen=RExC_seen;
DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log,"Restudying\n"));
-
+
RExC_state = copyRExC_state;
- if (seen & REG_TOP_LEVEL_BRANCHES)
- RExC_seen |= REG_TOP_LEVEL_BRANCHES;
+ if (seen & REG_TOP_LEVEL_BRANCHES_SEEN)
+ RExC_seen |= REG_TOP_LEVEL_BRANCHES_SEEN;
else
- RExC_seen &= ~REG_TOP_LEVEL_BRANCHES;
+ RExC_seen &= ~REG_TOP_LEVEL_BRANCHES_SEEN;
StructCopy(&zero_scan_data, &data, scan_data_t);
}
#else
StructCopy(&zero_scan_data, &data, scan_data_t);
-#endif
+#endif
/* Dig out information for optimizations. */
r->extflags = RExC_flags; /* was pm_op */
/*dmq: removed as part of de-PMOP: pm->op_pmflags = RExC_flags; */
-
+
if (UTF)
SvUTF8_on(rx); /* Unicode in it? */
ri->regstclass = NULL;
/* testing for BRANCH here tells us whether there is "must appear"
data in the pattern. If there is then we can use it for optimisations */
- if (!(RExC_seen & REG_TOP_LEVEL_BRANCHES)) { /* Only one top-level choice. */
+ if (!(RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN)) { /* Only one top-level choice.
+ */
SSize_t fake;
STRLEN longest_float_length, longest_fixed_length;
regnode_ssc ch_class; /* pointed to by data */
regnode *first_next= regnext(first);
/*
* Skip introductions and multiplicators >= 1
- * so that we can extract the 'meat' of the pattern that must
+ * so that we can extract the 'meat' of the pattern that must
* match in the large if() sequence following.
* NOTE that EXACT is NOT covered here, as it is normally
- * picked up by the optimiser separately.
+ * picked up by the optimiser separately.
*
* This is unfortunate as the optimiser isnt handling lookahead
* properly currently.
(PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) ||
(OP(first) == NOTHING && PL_regkind[OP(first_next)] != END ))
{
- /*
+ /*
* the only op that could be a regnode is PLUS, all the rest
* will be regnode_1 or regnode_2.
*
}
#ifdef TRIE_STCLASS
else if (PL_regkind[OP(first)] == TRIE &&
- ((reg_trie_data *)ri->data->data[ ARG(first) ])->minlen>0)
+ ((reg_trie_data *)ri->data->data[ ARG(first) ])->minlen>0)
{
regnode *trie_op;
/* this can happen only on restudy */
PL_regkind[OP(first)] == NBOUND)
ri->regstclass = first;
else if (PL_regkind[OP(first)] == BOL) {
- r->extflags |= (OP(first) == MBOL
- ? RXf_ANCH_MBOL
+ r->intflags |= (OP(first) == MBOL
+ ? PREGf_ANCH_MBOL
: (OP(first) == SBOL
- ? RXf_ANCH_SBOL
- : RXf_ANCH_BOL));
+ ? PREGf_ANCH_SBOL
+ : PREGf_ANCH_BOL));
first = NEXTOPER(first);
goto again;
}
else if (OP(first) == GPOS) {
- r->extflags |= RXf_ANCH_GPOS;
+ r->intflags |= PREGf_ANCH_GPOS;
first = NEXTOPER(first);
goto again;
}
else if ((!sawopen || !RExC_sawback) &&
(OP(first) == STAR &&
PL_regkind[OP(NEXTOPER(first))] == REG_ANY) &&
- !(r->extflags & RXf_ANCH) && !pRExC_state->num_code_blocks)
+ !(r->intflags & PREGf_ANCH) && !pRExC_state->num_code_blocks)
{
/* turn .* into ^.* with an implied $*=1 */
const int type =
(OP(NEXTOPER(first)) == REG_ANY)
- ? RXf_ANCH_MBOL
- : RXf_ANCH_SBOL;
- r->extflags |= type;
- r->intflags |= PREGf_IMPLICIT;
+ ? PREGf_ANCH_MBOL
+ : PREGf_ANCH_SBOL;
+ r->intflags |= (type | PREGf_IMPLICIT);
first = NEXTOPER(first);
goto again;
}
- if (sawplus && !sawminmod && !sawlookahead && (!sawopen || !RExC_sawback)
+ if (sawplus && !sawminmod && !sawlookahead
+ && (!sawopen || !RExC_sawback)
&& !pRExC_state->num_code_blocks) /* May examine pos and $& */
/* x+ must match at the 1st pos of run of x's */
r->intflags |= PREGf_SKIP;
} else /* XXXX Check for BOUND? */
stclass_flag = 0;
data.last_closep = &last_close;
-
- minlen = study_chunk(pRExC_state, &first, &minlen, &fake, scan + RExC_size, /* Up to end */
- &data, -1, NULL, NULL,
+
+ DEBUG_RExC_seen();
+ minlen = study_chunk(pRExC_state, &first, &minlen, &fake,
+ scan + RExC_size, /* Up to end */
+ &data, -1, 0, NULL,
SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag
| (restudied ? SCF_TRIE_DOING_RESTUDY : 0),
0);
if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
&& data.last_start_min == 0 && data.last_end > 0
&& !RExC_seen_zerolen
- && !(RExC_seen & REG_SEEN_VERBARG)
- && !((RExC_seen & REG_SEEN_GPOS) || (r->extflags & RXf_ANCH_GPOS)))
+ && !(RExC_seen & REG_VERBARG_SEEN)
+ && !(RExC_seen & REG_GPOS_SEEN)
+ ){
r->extflags |= RXf_CHECK_ALL;
+ }
scan_commit(pRExC_state, &data,&minlen,0);
longest_float_length = CHR_SVLEN(data.longest_float);
if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset)
&& stclass_flag
- && ! ANYOF_FLAGS(data.start_class) & ANYOF_EMPTY_STRING
+ && ! (ANYOF_FLAGS(data.start_class) & ANYOF_EMPTY_STRING)
&& !ssc_is_anything(data.start_class))
{
const U32 n = add_data(pRExC_state, STR_WITH_LEN("f"));
data.start_class = NULL;
}
- /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
+ /* A temporary algorithm prefers floated substr to fixed one to dig
+ * more info. */
if (longest_fixed_length > longest_float_length) {
r->check_end_shift = r->anchored_end_shift;
r->check_substr = r->anchored_substr;
r->check_utf8 = r->anchored_utf8;
r->check_offset_min = r->check_offset_max = r->anchored_offset;
- if (r->extflags & RXf_ANCH_SINGLE)
- r->extflags |= RXf_NOSCAN;
+ if (r->intflags & PREGf_ANCH_SINGLE)
+ r->intflags |= PREGf_NOSCAN;
}
else {
r->check_end_shift = r->float_end_shift;
if ( (STRLEN)minlen < longest_float_length )
minlen= longest_float_length;
if ( (STRLEN)minlen < longest_fixed_length )
- minlen= longest_fixed_length;
+ minlen= longest_fixed_length;
*/
}
else {
data.start_class = &ch_class;
data.last_closep = &last_close;
-
- minlen = study_chunk(pRExC_state, &scan, &minlen, &fake, scan + RExC_size,
- &data, -1, NULL, NULL,
- SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS
- |(restudied ? SCF_TRIE_DOING_RESTUDY : 0),
+ DEBUG_RExC_seen();
+ minlen = study_chunk(pRExC_state,
+ &scan, &minlen, &fake, scan + RExC_size, &data, -1, 0, NULL,
+ SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS|(restudied
+ ? SCF_TRIE_DOING_RESTUDY
+ : 0),
0);
-
+
CHECK_RESTUDY_GOTO_butfirst(NOOP);
r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8
= r->float_substr = r->float_utf8 = NULL;
- if (! ANYOF_FLAGS(data.start_class) & ANYOF_EMPTY_STRING
- && !ssc_is_anything(data.start_class))
- {
+ if (! (ANYOF_FLAGS(data.start_class) & ANYOF_EMPTY_STRING)
+ && ! ssc_is_anything(data.start_class))
+ {
const U32 n = add_data(pRExC_state, STR_WITH_LEN("f"));
ssc_finalize(pRExC_state, data.start_class);
/* Guard against an embedded (?=) or (?<=) with a longer minlen than
the "real" pattern. */
DEBUG_OPTIMISE_r({
- PerlIO_printf(Perl_debug_log,"minlen: %"IVdf" r->minlen:%"IVdf"\n",
- (IV)minlen, (IV)r->minlen);
+ PerlIO_printf(Perl_debug_log,"minlen: %"IVdf" r->minlen:%"IVdf" maxlen:%ld\n",
+ (IV)minlen, (IV)r->minlen, RExC_maxlen);
});
r->minlenret = minlen;
- if (r->minlen < minlen)
+ if (r->minlen < minlen)
r->minlen = minlen;
-
- if (RExC_seen & REG_SEEN_GPOS)
- r->extflags |= RXf_GPOS_SEEN;
- if (RExC_seen & REG_SEEN_LOOKBEHIND)
- r->extflags |= RXf_NO_INPLACE_SUBST; /* inplace might break the lookbehind */
+
+
+
+ if (RExC_seen & REG_GPOS_SEEN)
+ r->intflags |= PREGf_GPOS_SEEN;
+ if (RExC_seen & REG_LOOKBEHIND_SEEN)
+ r->extflags |= RXf_NO_INPLACE_SUBST; /* inplace might break the
+ lookbehind */
if (pRExC_state->num_code_blocks)
r->extflags |= RXf_EVAL_SEEN;
- if (RExC_seen & REG_SEEN_CANY)
- r->extflags |= RXf_CANY_SEEN;
- if (RExC_seen & REG_SEEN_VERBARG)
+ if (RExC_seen & REG_CANY_SEEN)
+ r->intflags |= PREGf_CANY_SEEN;
+ if (RExC_seen & REG_VERBARG_SEEN)
{
r->intflags |= PREGf_VERBARG_SEEN;
r->extflags |= RXf_NO_INPLACE_SUBST; /* don't understand this! Yves */
}
- if (RExC_seen & REG_SEEN_CUTGROUP)
+ if (RExC_seen & REG_CUTGROUP_SEEN)
r->intflags |= PREGf_CUTGROUP_SEEN;
if (pm_flags & PMf_USE_RE_EVAL)
r->intflags |= PREGf_USE_RE_EVAL;
else
RXp_PAREN_NAMES(r) = NULL;
+ if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN)
+ r->extflags |= RXf_UNBOUNDED_QUANTIFIER_SEEN;
+
+ /* If we have seen an anchor in our pattern then we set the extflag RXf_IS_ANCHORED
+ * so it can be used in pp.c */
+ if (r->intflags & PREGf_ANCH)
+ r->extflags |= RXf_IS_ANCHORED;
+
{
regnode *first = ri->program + 1;
U8 fop = OP(first);
r->extflags |= RXf_NULL;
else if (PL_regkind[fop] == BOL && nop == END)
r->extflags |= RXf_START_ONLY;
- else if (fop == PLUS && PL_regkind[nop] == POSIXD && FLAGS(next) == _CC_SPACE && OP(regnext(first)) == END)
+ else if (fop == PLUS
+ && PL_regkind[nop] == POSIXD && FLAGS(next) == _CC_SPACE
+ && OP(regnext(first)) == END)
r->extflags |= RXf_WHITE;
- else if ( r->extflags & RXf_SPLIT && fop == EXACT && STR_LEN(first) == 1 && *(STRING(first)) == ' ' && OP(regnext(first)) == END )
+ else if ( r->extflags & RXf_SPLIT
+ && fop == EXACT
+ && STR_LEN(first) == 1
+ && *(STRING(first)) == ' '
+ && OP(regnext(first)) == END )
r->extflags |= (RXf_SKIPWHITE|RXf_WHITE);
}
#ifdef DEBUGGING
if (RExC_paren_names) {
ri->name_list_idx = add_data( pRExC_state, STR_WITH_LEN("a"));
- ri->data->data[ri->name_list_idx] = (void*)SvREFCNT_inc(RExC_paren_name_list);
+ ri->data->data[ri->name_list_idx]
+ = (void*)SvREFCNT_inc(RExC_paren_name_list);
} else
#endif
ri->name_list_idx = 0;
/* assume we don't need to swap parens around before we match */
DEBUG_DUMP_r({
+ DEBUG_RExC_seen();
PerlIO_printf(Perl_debug_log,"Final program:\n");
regdump(r);
});
const STRLEN len = ri->u.offsets[0];
STRLEN i;
GET_RE_DEBUG_FLAGS_DECL;
- PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)ri->u.offsets[0]);
+ PerlIO_printf(Perl_debug_log,
+ "Offsets: [%"UVuf"]\n\t", (UV)ri->u.offsets[0]);
for (i = 1; i <= len; i++) {
if (ri->u.offsets[i*2-1] || ri->u.offsets[i*2])
PerlIO_printf(Perl_debug_log, "%"UVuf":%"UVuf"[%"UVuf"] ",
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);
+ Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_iter",
+ (int)flags);
return NULL;
}
}
SvREFCNT_dec_NN(ret);
return newSViv(length + 1);
} else {
- Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar", (int)flags);
+ Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar",
+ (int)flags);
return NULL;
}
}
I32 n = paren;
PERL_ARGS_ASSERT_REG_NUMBERED_BUFF_FETCH;
-
+
if ( n == RX_BUFF_IDX_CARET_PREMATCH
|| n == RX_BUFF_IDX_CARET_FULLMATCH
|| n == RX_BUFF_IDX_CARET_POSTMATCH
i = rx->offs[0].start;
s = rx->subbeg;
}
- else
+ else
if ((n == RX_BUFF_IDX_POSTMATCH || n == RX_BUFF_IDX_CARET_POSTMATCH)
&& rx->offs[0].end != -1)
{
/* $', ${^POSTMATCH} */
s = rx->subbeg - rx->suboffset + rx->offs[0].end;
i = rx->sublen + rx->suboffset - rx->offs[0].end;
- }
+ }
else
if ( 0 <= n && n <= (I32)rx->nparens &&
(s1 = rx->offs[n].start) != -1 &&
s = rx->subbeg + s1 - rx->suboffset;
} else {
goto ret_undef;
- }
+ }
assert(s >= rx->subbeg);
assert((STRLEN)rx->sublen >= (STRLEN)((s - rx->subbeg) + i) );
sv_setpvn(sv, s, i);
TAINT_set(oldtainted);
#endif
- if ( (rx->extflags & RXf_CANY_SEEN)
+ if ( (rx->intflags & PREGf_CANY_SEEN)
? (RXp_MATCH_UTF8(rx)
&& (!i || is_utf8_string((U8*)s, i)))
: (RXp_MATCH_UTF8(rx)) )
TAINT;
SvTAINT(sv);
}
- } else
+ } else
SvTAINTED_off(sv);
}
} else {
PERL_ARGS_ASSERT_REG_SCAN_NAME;
- if (isIDFIRST_lazy_if(RExC_parse, UTF)) {
+ assert (RExC_parse <= RExC_end);
+ if (RExC_parse == RExC_end) NOOP;
+ else if (isIDFIRST_lazy_if(RExC_parse, UTF)) {
/* skip IDFIRST by using do...while */
if (UTF)
do {
RExC_parse++;
} while (isWORDCHAR(*RExC_parse));
} else {
- RExC_parse++; /* so the <- from the vFAIL is after the offending character */
+ RExC_parse++; /* so the <- from the vFAIL is after the offending
+ character */
vFAIL("Group name must start with a non-digit word character");
}
if ( flags ) {
return new_list;
}
-#endif
-STATIC SV*
-S__new_invlist_C_array(pTHX_ const UV* const list)
+SV*
+Perl__new_invlist_C_array(pTHX_ const UV* const list)
{
/* Return a pointer to a newly constructed inversion list, initialized to
* point to <list>, which has to be in the exact correct inversion list
/* Initialize the iteration pointer. */
invlist_iterfinish(invlist);
+ SvREADONLY_on(invlist);
+
return invlist;
}
+#endif /* ifndef PERL_IN_XSUB_RE */
STATIC void
S_invlist_extend(pTHX_ SV* const invlist, const UV new_max)
}
STATIC void
-S__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV end)
+S__append_range_to_invlist(pTHX_ SV* const invlist,
+ const UV start, const UV end)
{
/* Subject to change or removal. Append the range from 'start' to 'end' at
* the end of the inversion list. The range must be above any existing
|| ELEMENT_RANGE_MATCHES_INVLIST(final_element))
{
Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%"UVuf", start=%"UVuf", match=%c",
- array[final_element], start,
- ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f');
+ array[final_element], start,
+ ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f');
}
/* Here, it is a legal append. If the new range begins with the first
}
void
-Perl__invlist_populate_swatch(pTHX_ SV* const invlist, const UV start, const UV end, U8* swatch)
+Perl__invlist_populate_swatch(pTHX_ SV* const invlist,
+ const UV start, const UV end, U8* swatch)
{
/* populates a swatch of a swash the same way swatch_get() does in utf8.c,
* but is used when the swash has an inversion list. This makes this much
}
void
-Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, const bool complement_b, SV** output)
+Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b,
+ const bool complement_b, SV** output)
{
/* Take the union of two inversion lists and point <output> to it. *output
* SHOULD BE DEFINED upon input, and if it points to one of the two lists,
if (*output == a) {
if (a != NULL) {
- if (! (make_temp = SvTEMP(a))) {
+ if (! (make_temp = cBOOL(SvTEMP(a)))) {
SvREFCNT_dec_NN(a);
}
}
else if ((len_b = _invlist_len(b)) == 0) {
bool make_temp = FALSE;
if (*output == b) {
- if (! (make_temp = SvTEMP(b))) {
+ if (! (make_temp = cBOOL(SvTEMP(b)))) {
SvREFCNT_dec_NN(b);
}
}
* so the union with <a> includes everything too */
if (complement_b) {
if (a == *output) {
- if (! (make_temp = SvTEMP(a))) {
+ if (! (make_temp = cBOOL(SvTEMP(a)))) {
SvREFCNT_dec_NN(a);
}
}
}
void
-Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, const bool complement_b, SV** i)
+Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b,
+ const bool complement_b, SV** i)
{
/* Take the intersection of two inversion lists and point <i> to it. *i
* SHOULD BE DEFINED upon input, and if it points to one of the two lists,
* simply 'a'. */
if (*i != a) {
if (*i == b) {
- if (! (make_temp = SvTEMP(b))) {
+ if (! (make_temp = cBOOL(SvTEMP(b)))) {
SvREFCNT_dec_NN(b);
}
}
/* Here, 'a' or 'b' is empty and not using the complement of 'b'. The
* intersection must be empty */
if (*i == a) {
- if (! (make_temp = SvTEMP(a))) {
+ if (! (make_temp = cBOOL(SvTEMP(a)))) {
SvREFCNT_dec_NN(a);
}
}
else if (*i == b) {
- if (! (make_temp = SvTEMP(b))) {
+ if (! (make_temp = cBOOL(SvTEMP(b)))) {
SvREFCNT_dec_NN(b);
}
}
}
/* The final length is what we've output so far plus what else is in the
- * intersection. At most one of the subexpressions below will be non-zero */
+ * intersection. At most one of the subexpressions below will be non-zero
+ * */
len_r = i_r;
if (count >= 2) {
len_r += (len_a - i_a) + (len_b - i_b);
return invlist;
}
+SV*
+Perl__setup_canned_invlist(pTHX_ const STRLEN size, const UV element0,
+ UV** other_elements_ptr)
+{
+ /* Create and return an inversion list whose contents are to be populated
+ * by the caller. The caller gives the number of elements (in 'size') and
+ * the very first element ('element0'). This function will set
+ * '*other_elements_ptr' to an array of UVs, where the remaining elements
+ * are to be placed.
+ *
+ * Obviously there is some trust involved that the caller will properly
+ * fill in the other elements of the array.
+ *
+ * (The first element needs to be passed in, as the underlying code does
+ * things differently depending on whether it is zero or non-zero) */
+
+ SV* invlist = _new_invlist(size);
+ bool offset;
+
+ PERL_ARGS_ASSERT__SETUP_CANNED_INVLIST;
+
+ _append_range_to_invlist(invlist, element0, element0);
+ offset = *get_invlist_offset_addr(invlist);
+
+ invlist_set_len(invlist, size, offset);
+ *other_elements_ptr = invlist_array(invlist) + 1;
+ return invlist;
+}
+
#endif
PERL_STATIC_INLINE SV*
*get_invlist_offset_addr(invlist) = ! *get_invlist_offset_addr(invlist);
}
-void
-Perl__invlist_invert_prop(pTHX_ SV* const invlist)
-{
- /* Complement the input inversion list (which must be a Unicode property,
- * all of which don't match above the Unicode maximum code point.) And
- * Perl has chosen to not have the inversion match above that either. This
- * adds a 0x110000 if the list didn't end with it, and removes it if it did
- */
-
- UV len;
- UV* array;
-
- PERL_ARGS_ASSERT__INVLIST_INVERT_PROP;
-
- _invlist_invert(invlist);
-
- len = _invlist_len(invlist);
-
- if (len != 0) { /* If empty do nothing */
- array = invlist_array(invlist);
- if (array[len - 1] != PERL_UNICODE_MAX + 1) {
- /* Add 0x110000. First, grow if necessary */
- len++;
- if (invlist_max(invlist) < len) {
- invlist_extend(invlist, len);
- array = invlist_array(invlist);
- }
- invlist_set_len(invlist, len, *get_invlist_offset_addr(invlist));
- array[len - 1] = PERL_UNICODE_MAX + 1;
- }
- else { /* Remove the 0x110000 */
- invlist_set_len(invlist, len - 1, *get_invlist_offset_addr(invlist));
- }
- }
-
- return;
-}
#endif
PERL_STATIC_INLINE SV*
#ifndef PERL_IN_XSUB_RE
void
-Perl__invlist_dump(pTHX_ PerlIO *file, I32 level, const char * const indent, SV* const invlist)
+Perl__invlist_dump(pTHX_ PerlIO *file, I32 level,
+ const char * const indent, SV* const invlist)
{
/* Designed to be called only by do_sv_dump(). Dumps out the ranges of the
* inversion list 'invlist' to 'file' at 'level' Each line is prefixed by
vFAIL2("Regexp modifier \"%c\" may appear a maximum of twice", ASCII_RESTRICT_PAT_MOD);
}
else if (has_charset_modifier == *(RExC_parse - 1)) {
- vFAIL2("Regexp modifier \"%c\" may not appear twice", *(RExC_parse - 1));
+ vFAIL2("Regexp modifier \"%c\" may not appear twice",
+ *(RExC_parse - 1));
}
else {
vFAIL3("Regexp modifiers \"%c\" and \"%c\" are mutually exclusive", has_charset_modifier, *(RExC_parse - 1));
/*NOTREACHED*/
neg_modifier:
RExC_parse++;
- vFAIL2("Regexp modifier \"%c\" may not appear after the \"-\"", *(RExC_parse - 1));
+ vFAIL2("Regexp modifier \"%c\" may not appear after the \"-\"",
+ *(RExC_parse - 1));
/*NOTREACHED*/
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;
+ const I32 wflagbit = *RExC_parse == 'o'
+ ? WASTED_O
+ : WASTED_G;
if (! (wastedflags & wflagbit) ) {
wastedflags |= wflagbit;
/* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */
default:
fail_modifiers:
RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1;
+ /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */
vFAIL2utf8f("Sequence (%"UTF8f"...) not recognized",
UTF8fARG(UTF, RExC_parse-seqstart, seqstart));
/*NOTREACHED*/
char *start_arg = NULL;
unsigned char op = 0;
int argok = 1;
- int internal_argval = 0; /* internal_argval is only useful if !argok */
+ int internal_argval = 0; /* internal_argval is only useful if
+ !argok */
if (has_intervening_patws && SIZE_ONLY) {
ckWARNregdep(RExC_parse + 1, "In '(*VERB...)', splitting the initial '(*' is deprecated");
verb_len = RExC_parse - start_verb;
if ( start_arg ) {
RExC_parse++;
- while ( *RExC_parse && *RExC_parse != ')' )
+ while ( *RExC_parse && *RExC_parse != ')' )
RExC_parse++;
- if ( *RExC_parse != ')' )
+ if ( *RExC_parse != ')' )
vFAIL("Unterminated verb pattern argument");
if ( RExC_parse == start_arg )
start_arg = NULL;
if ( *RExC_parse != ')' )
vFAIL("Unterminated verb pattern");
}
-
+
switch ( *start_verb ) {
case 'A': /* (*ACCEPT) */
if ( memEQs(start_verb,verb_len,"ACCEPT") ) {
if ( memEQs(start_verb,verb_len,"PRUNE") )
op = PRUNE;
break;
- case 'S': /* (*SKIP) */
- if ( memEQs(start_verb,verb_len,"SKIP") )
+ case 'S': /* (*SKIP) */
+ if ( memEQs(start_verb,verb_len,"SKIP") )
op = SKIP;
break;
case 'T': /* (*THEN) */
/* [19:06] <TimToady> :: is then */
if ( memEQs(start_verb,verb_len,"THEN") ) {
op = CUTGROUP;
- RExC_seen |= REG_SEEN_CUTGROUP;
+ RExC_seen |= REG_CUTGROUP_SEEN;
}
break;
}
if ( argok ) {
if ( start_arg && internal_argval ) {
vFAIL3("Verb pattern '%.*s' may not have an argument",
- verb_len, start_verb);
+ verb_len, start_verb);
} else if ( argok < 0 && !start_arg ) {
vFAIL3("Verb pattern '%.*s' has a mandatory argument",
- verb_len, start_verb);
+ verb_len, start_verb);
} else {
ret = reganode(pRExC_state, op, internal_argval);
if ( ! internal_argval && ! SIZE_ONLY ) {
if (start_arg) {
- SV *sv = newSVpvn( start_arg, RExC_parse - start_arg);
- ARG(ret) = add_data( pRExC_state, STR_WITH_LEN("S"));
+ SV *sv = newSVpvn( start_arg,
+ RExC_parse - start_arg);
+ ARG(ret) = add_data( pRExC_state,
+ STR_WITH_LEN("S"));
RExC_rxi->data->data[ARG(ret)]=(void*)sv;
ret->flags = 0;
} else {
- ret->flags = 1;
+ ret->flags = 1;
}
- }
+ }
}
if (!internal_argval)
- RExC_seen |= REG_SEEN_VERBARG;
+ RExC_seen |= REG_VERBARG_SEEN;
} else if ( start_arg ) {
vFAIL3("Verb pattern '%.*s' may not have an argument",
- verb_len, start_verb);
+ verb_len, start_verb);
} else {
ret = reg_node(pRExC_state, op);
}
goto named_recursion;
}
else if (paren == '=') { /* (?P=...) named backref */
- /* this pretty much dupes the code for \k<NAME> in regatom(), if
- you change this make sure you change that */
+ /* this pretty much dupes the code for \k<NAME> in
+ * regatom(), if you change this make sure you change that
+ * */
char* name_start = RExC_parse;
U32 num = 0;
SV *sv_dat = reg_scan_name(pRExC_state,
SIZE_ONLY ? REG_RSN_RETURN_NULL : REG_RSN_RETURN_DATA);
if (RExC_parse == name_start || *RExC_parse != ')')
+ /* diag_listed_as: Sequence ?P=... not terminated in regex; marked by <-- HERE in m/%s/ */
vFAIL2("Sequence %.3s... not terminated",parse_start);
if (!SIZE_ONLY) {
return ret;
}
RExC_parse++;
- vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart);
+ /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */
+ vFAIL3("Sequence (%.*s...) not recognized",
+ RExC_parse-seqstart, seqstart);
/*NOTREACHED*/
case '<': /* (?<...) */
if (*RExC_parse == '!')
paren = ',';
- else if (*RExC_parse != '=')
+ else if (*RExC_parse != '=')
named_capture:
{ /* (?<...>) */
char *name_start;
case '\'': /* (?'...') */
name_start= RExC_parse;
svname = reg_scan_name(pRExC_state,
- SIZE_ONLY ? /* reverse test from the others */
- REG_RSN_RETURN_NAME :
- REG_RSN_RETURN_NULL);
- if (RExC_parse == name_start) {
- RExC_parse++;
- vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart);
- /*NOTREACHED*/
- }
- if (*RExC_parse != paren)
+ SIZE_ONLY /* reverse test from the others */
+ ? REG_RSN_RETURN_NAME
+ : REG_RSN_RETURN_NULL);
+ if (RExC_parse == name_start || *RExC_parse != paren)
vFAIL2("Sequence (?%c... not terminated",
paren=='>' ? '<' : paren);
if (SIZE_ONLY) {
}
}
if ( count ) {
- pv = (I32*)SvGROW(sv_dat, SvCUR(sv_dat) + sizeof(I32)+1);
+ pv = (I32*)SvGROW(sv_dat,
+ SvCUR(sv_dat) + sizeof(I32)+1);
SvCUR_set(sv_dat, SvCUR(sv_dat) + sizeof(I32));
pv[count] = RExC_npar;
SvIV_set(sv_dat, SvIVX(sv_dat) + 1);
}
} else {
(void)SvUPGRADE(sv_dat,SVt_PVNV);
- sv_setpvn(sv_dat, (char *)&(RExC_npar), sizeof(I32));
+ sv_setpvn(sv_dat, (char *)&(RExC_npar),
+ sizeof(I32));
SvIOK_on(sv_dat);
SvIV_set(sv_dat, 1);
}
#ifdef DEBUGGING
- /* Yes this does cause a memory leak in debugging Perls */
- if (!av_store(RExC_paren_name_list, RExC_npar, SvREFCNT_inc(svname)))
+ /* Yes this does cause a memory leak in debugging Perls
+ * */
+ if (!av_store(RExC_paren_name_list,
+ RExC_npar, SvREFCNT_inc(svname)))
SvREFCNT_dec_NN(svname);
#endif
paren = 1;
goto capturing_parens;
}
- RExC_seen |= REG_SEEN_LOOKBEHIND;
+ RExC_seen |= REG_LOOKBEHIND_SEEN;
RExC_in_lookbehind++;
RExC_parse++;
case '=': /* (?=...) */
case '|': /* (?|...) */
/* branch reset, behave like a (?:...) except that
buffers in alternations share the same numbers */
- paren = ':';
+ paren = ':';
after_freeze = freeze_paren = RExC_npar;
break;
case ':': /* (?:...) */
if (*RExC_parse != ')')
FAIL("Sequence (?R) not terminated");
ret = reg_node(pRExC_state, GOSTART);
+ RExC_seen |= REG_GOSTART_SEEN;
*flagp |= POSTPONED;
nextchar(pRExC_state);
return ret;
SIZE_ONLY ? REG_RSN_RETURN_NULL : REG_RSN_RETURN_DATA);
num = sv_dat ? *((I32 *)SvPVX(sv_dat)) : 0;
}
+ if (RExC_parse == RExC_end || *RExC_parse != ')')
+ vFAIL("Sequence (?&... not terminated");
goto gen_recurse_regop;
assert(0); /* NOT REACHED */
case '+':
if (!(RExC_parse[0] >= '1' && RExC_parse[0] <= '9')) {
RExC_parse--; /* rewind to let it be handled later */
goto parse_flags;
- }
+ }
/*FALLTHROUGH */
case '1': case '2': case '3': case '4': /* (?1) */
case '5': case '6': case '7': case '8': case '9':
RExC_parse++;
while (isDIGIT(*RExC_parse))
RExC_parse++;
- if (*RExC_parse!=')')
+ if (*RExC_parse!=')')
vFAIL("Expecting close bracket");
gen_recurse_regop:
ARG2L_SET( ret, RExC_recurse_count++);
RExC_emit++;
DEBUG_OPTIMISE_MORE_r(PerlIO_printf(Perl_debug_log,
- "Recurse #%"UVuf" to %"IVdf"\n", (UV)ARG(ret), (IV)ARG2L(ret)));
+ "Recurse #%"UVuf" to %"IVdf"\n",
+ (UV)ARG(ret), (IV)ARG2L(ret)));
} else {
RExC_size++;
}
- RExC_seen |= REG_SEEN_RECURSE;
+ RExC_seen |= REG_RECURSE_SEEN;
Set_Node_Length(ret, 1 + regarglen[OP(ret)]); /* MJD */
Set_Node_Offset(ret, parse_start); /* MJD */
is_logical = 1;
if (*RExC_parse != '{') {
RExC_parse++;
+ /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */
vFAIL2utf8f(
"Sequence (%"UTF8f"...) not recognized",
UTF8fARG(UTF, RExC_parse-seqstart, seqstart));
ret = reg_node(pRExC_state, LOGICAL);
if (!SIZE_ONLY)
ret->flags = 1;
-
+
tail = reg(pRExC_state, 1, &flag, depth+1);
if (flag & RESTART_UTF8) {
*flagp = RESTART_UTF8;
SV *sv_dat;
RExC_parse++;
sv_dat = reg_scan_name(pRExC_state,
- SIZE_ONLY ? REG_RSN_RETURN_NULL : REG_RSN_RETURN_DATA);
+ SIZE_ONLY
+ ? REG_RSN_RETURN_NULL
+ : REG_RSN_RETURN_DATA);
parno = sv_dat ? *((I32 *)SvPVX(sv_dat)) : 0;
}
- ret = reganode(pRExC_state,INSUBP,parno);
+ ret = reganode(pRExC_state,INSUBP,parno);
goto insert_if_check_paren;
}
else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) {
insert_if_check_paren:
if (*(tmp = nextchar(pRExC_state)) != ')') {
- if ( UTF ) {
- /* Like the name implies, nextchar deals in chars,
- * not characters, so if under UTF, undo its work
+ /* nextchar also skips comments, so undo its work
* and skip over the the next character.
*/
- RExC_parse = tmp;
- RExC_parse += UTF8SKIP(RExC_parse);
- }
+ RExC_parse = tmp;
+ RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1;
vFAIL("Switch condition not recognized");
}
insert_if:
FAIL2("panic: regbranch returned NULL, flags=%#"UVxf"",
(UV) flags);
} else
- REGTAIL(pRExC_state, br, reganode(pRExC_state, LONGJMP, 0));
+ REGTAIL(pRExC_state, br, reganode(pRExC_state,
+ LONGJMP, 0));
c = *nextchar(pRExC_state);
if (flags&HASWIDTH)
*flagp |= HASWIDTH;
if (c == '|') {
- if (is_define)
+ if (is_define)
vFAIL("(?(DEFINE)....) does not allow branches");
- lastbr = reganode(pRExC_state, IFTHEN, 0); /* Fake one for optimizer. */
+
+ /* Fake one for optimizer. */
+ lastbr = reganode(pRExC_state, IFTHEN, 0);
+
if (!regbranch(pRExC_state, &flags, 1,depth+1)) {
if (flags & RESTART_UTF8) {
*flagp = RESTART_UTF8;
capturing_parens:
parno = RExC_npar;
RExC_npar++;
-
+
ret = reganode(pRExC_state, OPEN, parno);
if (!SIZE_ONLY ){
- if (!RExC_nestroot)
+ if (!RExC_nestroot)
RExC_nestroot = parno;
- if (RExC_seen & REG_SEEN_RECURSE
+ if (RExC_seen & REG_RECURSE_SEEN
&& !RExC_open_parens[parno-1])
{
DEBUG_OPTIMISE_MORE_r(PerlIO_printf(Perl_debug_log,
- "Setting open paren #%"IVdf" to %d\n",
+ "Setting open paren #%"IVdf" to %d\n",
(IV)parno, REG_NODE_NUM(ret)));
RExC_open_parens[parno-1]= ret;
}
}
else /* ! paren */
ret = NULL;
-
+
parse_rest:
/* Pick up the branches, linking them together. */
parse_start = RExC_parse; /* MJD */
while (*RExC_parse == '|') {
if (!SIZE_ONLY && RExC_extralen) {
ender = reganode(pRExC_state, LONGJMP,0);
- REGTAIL(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
+
+ /* Append to the previous. */
+ REGTAIL(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender);
}
if (SIZE_ONLY)
RExC_extralen += 2; /* Account for LONGJMP. */
if (freeze_paren) {
if (RExC_npar > after_freeze)
after_freeze = RExC_npar;
- RExC_npar = freeze_paren;
+ RExC_npar = freeze_paren;
}
br = regbranch(pRExC_state, &flags, 0, depth+1);
break;
case 1: case 2:
ender = reganode(pRExC_state, CLOSE, parno);
- if (!SIZE_ONLY && RExC_seen & REG_SEEN_RECURSE) {
+ if (!SIZE_ONLY && RExC_seen & REG_RECURSE_SEEN) {
DEBUG_OPTIMISE_MORE_r(PerlIO_printf(Perl_debug_log,
- "Setting close paren #%"IVdf" to %d\n",
+ "Setting close paren #%"IVdf" to %d\n",
(IV)parno, REG_NODE_NUM(ender)));
RExC_close_parens[parno-1]= ender;
- if (RExC_nestroot == parno)
+ if (RExC_nestroot == parno)
RExC_nestroot = 0;
- }
+ }
Set_Node_Offset(ender,RExC_parse+1); /* MJD */
Set_Node_Length(ender,1); /* MJD */
break;
if (have_branch && !SIZE_ONLY) {
char is_nothing= 1;
if (depth==1)
- RExC_seen |= REG_TOP_LEVEL_BRANCHES;
+ RExC_seen |= REG_TOP_LEVEL_BRANCHES_SEEN;
/* Hook the tails of the branches to the closing node. */
for (br = ret; br; br = regnext(br)) {
const U8 op = PL_regkind[OP(br)];
if (op == BRANCH) {
REGTAIL_STUDY(pRExC_state, NEXTOPER(br), ender);
- if (OP(NEXTOPER(br)) != NOTHING || regnext(NEXTOPER(br)) != ender)
+ if ( OP(NEXTOPER(br)) != NOTHING
+ || regnext(NEXTOPER(br)) != ender)
is_nothing= 0;
}
else if (op == BRANCHJ) {
REGTAIL_STUDY(pRExC_state, NEXTOPER(NEXTOPER(br)), ender);
/* for now we always disable this optimisation * /
- if (OP(NEXTOPER(NEXTOPER(br))) != NOTHING || regnext(NEXTOPER(NEXTOPER(br))) != ender)
+ if ( OP(NEXTOPER(NEXTOPER(br))) != NOTHING
+ || regnext(NEXTOPER(NEXTOPER(br))) != ender)
*/
is_nothing= 0;
}
ret = reg_node(pRExC_state, OPFAIL);
return ret;
}
+ else if (min == max
+ && RExC_parse < RExC_end
+ && (*RExC_parse == '?' || *RExC_parse == '+'))
+ {
+ if (SIZE_ONLY) {
+ ckWARN2reg(RExC_parse + 1,
+ "Useless use of greediness modifier '%c'",
+ *RExC_parse);
+ }
+ /* Absorb the modifier, so later code doesn't see nor use
+ * it */
+ nextchar(pRExC_state);
+ }
do_curly:
if ((flags&SIMPLE)) {
ARG1_SET(ret, (U16)min);
ARG2_SET(ret, (U16)max);
}
+ if (max == REG_INFTY)
+ RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN;
goto nest_check;
}
reginsert(pRExC_state, STAR, ret, depth+1);
ret->flags = 0;
RExC_naughty += 4;
+ RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN;
}
else if (op == '*') {
min = 0;
reginsert(pRExC_state, PLUS, ret, depth+1);
ret->flags = 0;
RExC_naughty += 3;
+ RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN;
}
else if (op == '+') {
min = 1;
SAVEFREESV(RExC_rx_sv); /* in case of fatal warnings */
ckWARN2reg(RExC_parse,
"%"UTF8f" matches null string many times",
- UTF8fARG(UTF, (RExC_parse >= origparse ? RExC_parse - origparse : 0),
+ UTF8fARG(UTF, (RExC_parse >= origparse
+ ? RExC_parse - origparse
+ : 0),
origparse));
(void)ReREFCNT_inc(RExC_rx_sv);
}
}
STATIC bool
-S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, regnode** node_p, UV *valuep, I32 *flagp, U32 depth, bool in_char_class,
- const bool strict /* Apply stricter parsing rules? */
+S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, regnode** node_p,
+ UV *valuep, I32 *flagp, U32 depth, bool in_char_class,
+ const bool strict /* Apply stricter parsing rules? */
)
{
-
+
/* This is expected to be called by a parser routine that has recognized '\N'
and needs to handle the rest. RExC_parse is expected to point at the first
char following the N at the time of the call. On successful return,
more than one character */
GET_RE_DEBUG_FLAGS_DECL;
-
+
PERL_ARGS_ASSERT_GROK_BSLASH_N;
GET_RE_DEBUG_FLAGS;
assert(cBOOL(node_p) ^ cBOOL(valuep)); /* Exactly one should be set */
/* The [^\n] meaning of \N ignores spaces and comments under the /x
- * modifier. The other meaning does not */
+ * modifier. The other meaning does not, so use a temporary until we find
+ * out which we are being called with */
p = (RExC_flags & RXf_PMf_EXTENDED)
? regwhite( pRExC_state, RExC_parse )
: RExC_parse;
if (*p != '{' || regcurly(p, FALSE)) {
RExC_parse = p;
if (! node_p) {
- /* no bare \N in a charclass */
+ /* no bare \N allowed in a charclass */
if (in_char_class) {
vFAIL("\\N in a character class must be a named character: \\N{...}");
}
return FALSE;
}
+ RExC_parse--; /* Need to back off so nextchar() doesn't skip the
+ current char */
nextchar(pRExC_state);
*node_p = reg_node(pRExC_state, REG_ANY);
*flagp |= HASWIDTH|SIMPLE;
RExC_naughty++;
- RExC_parse--;
Set_Node_Length(*node_p, 1); /* MJD */
return TRUE;
}
if (! (endbrace = strchr(RExC_parse, '}')) /* no trailing brace */
|| ! (endbrace == RExC_parse /* nothing between the {} */
- || (endbrace - RExC_parse >= 2 /* U+ (bad hex is checked below */
- && strnEQ(RExC_parse, "U+", 2)))) /* for a better error msg) */
+ || (endbrace - RExC_parse >= 2 /* U+ (bad hex is checked below
+ */
+ && strnEQ(RExC_parse, "U+", 2)))) /* for a better error msg)
+ */
{
if (endbrace) RExC_parse = endbrace; /* position msg's '<--HERE' */
vFAIL("\\N{NAME} must be resolved by the lexer");
}
FAIL2("panic: reg returned NULL to grok_bslash_N, flags=%#"UVxf"",
(UV) flags);
- }
+ }
*flagp |= flags&(HASWIDTH|SPSTART|SIMPLE|POSTPONED);
RExC_parse = endbrace;
}
PERL_STATIC_INLINE void
-S_alloc_maybe_populate_EXACT(pTHX_ RExC_state_t *pRExC_state, regnode *node, I32* flagp, STRLEN len, UV code_point)
+S_alloc_maybe_populate_EXACT(pTHX_ RExC_state_t *pRExC_state,
+ regnode *node, I32* flagp, STRLEN len, UV code_point)
{
/* This knows the details about sizing an EXACTish node, setting flags for
* it (by setting <*flagp>, and potentially populating it with a single
* If <len> is zero, the function assumes that the node is to contain only
* the single character given by <code_point> and calculates what <len>
* should be. In pass 1, it sizes the node appropriately. In pass 2, it
- * additionally will populate the node's STRING with <code_point>, if <len>
- * is 0. In both cases <*flagp> is appropriately set
+ * additionally will populate the node's STRING with <code_point> or its
+ * fold if folding.
+ *
+ * In both cases <*flagp> is appropriately set
*
* It knows that under FOLD, the Latin Sharp S and UTF characters above
* 255, must be folded (the former only when the rules indicate it can
if (! len_passed_in) {
if (UTF) {
- if (FOLD && (! LOC || code_point > 255)) {
+ if (UNI_IS_INVARIANT(code_point)) {
+ if (LOC || ! FOLD) { /* /l defers folding until runtime */
+ *character = (U8) code_point;
+ }
+ else { /* Here is /i and not /l (toFOLD() is defined on just
+ ASCII, which isn't the same thing as INVARIANT on
+ EBCDIC, but it works there, as the extra invariants
+ fold to themselves) */
+ *character = toFOLD((U8) code_point);
+ }
+ len = 1;
+ }
+ else if (FOLD && (! LOC
+ || ! is_PROBLEMATIC_LOCALE_FOLD_cp(code_point)))
+ { /* Folding, and ok to do so now */
_to_uni_fold_flags(code_point,
character,
&len,
- FOLD_FLAGS_FULL | ((LOC)
- ? FOLD_FLAGS_LOCALE
- : (ASCII_FOLD_RESTRICTED)
- ? FOLD_FLAGS_NOMIX_ASCII
- : 0));
+ FOLD_FLAGS_FULL | ((ASCII_FOLD_RESTRICTED)
+ ? FOLD_FLAGS_NOMIX_ASCII
+ : 0));
+ }
+ else if (code_point <= MAX_UTF8_TWO_BYTE) {
+
+ /* Not folding this cp, and can output it directly */
+ *character = UTF8_TWO_BYTE_HI(code_point);
+ *(character + 1) = UTF8_TWO_BYTE_LO(code_point);
+ len = 2;
}
else {
uvchr_to_utf8( character, code_point);
len = UTF8SKIP(character);
}
- }
- else if (! FOLD
- || code_point != LATIN_SMALL_LETTER_SHARP_S
- || ASCII_FOLD_RESTRICTED
- || ! AT_LEAST_UNI_SEMANTICS)
+ } /* Else pattern isn't UTF8. We only fold the sharp s, when
+ appropriate */
+ else if (UNLIKELY(code_point == LATIN_SMALL_LETTER_SHARP_S)
+ && FOLD
+ && AT_LEAST_UNI_SEMANTICS
+ && ! ASCII_FOLD_RESTRICTED)
{
- *character = (U8) code_point;
- len = 1;
- }
- else {
*character = 's';
*(character + 1) = 's';
len = 2;
}
+ else {
+ *character = (U8) code_point;
+ len = 1;
+ }
}
if (SIZE_ONLY) {
}
}
+
+/* return atoi(p), unless it's too big to sensibly be a backref,
+ * in which case return I32_MAX (rather than possibly 32-bit wrapping) */
+
+static I32
+S_backref_value(char *p)
+{
+ char *q = p;
+
+ for (;isDIGIT(*q); q++); /* calculate length of num */
+ if (q - p == 0 || q - p > 9)
+ return I32_MAX;
+ return atoi(p);
+}
+
+
/*
- regatom - the lowest level
by the other.
Returns NULL, setting *flagp to TRYAGAIN if reg() returns NULL with
- TRYAGAIN.
+ TRYAGAIN.
Returns NULL, setting *flagp to RESTART_UTF8 if the sizing scan needs to be
restarted.
Otherwise does not return NULL.
*flagp = RESTART_UTF8;
return NULL;
}
- FAIL2("panic: reg returned NULL to regatom, flags=%#"UVxf"", (UV) flags);
+ FAIL2("panic: reg returned NULL to regatom, flags=%#"UVxf"",
+ (UV) flags);
}
*flagp |= flags&(HASWIDTH|SPSTART|SIMPLE|POSTPONED);
break;
goto finish_meta_pat;
case 'G':
ret = reg_node(pRExC_state, GPOS);
- RExC_seen |= REG_SEEN_GPOS;
+ RExC_seen |= REG_GPOS_SEEN;
*flagp |= SIMPLE;
goto finish_meta_pat;
case 'K':
* be necessary here to avoid cases of memory corruption, as
* with: C<$_="x" x 80; s/x\K/y/> -- rgs
*/
- RExC_seen |= REG_SEEN_LOOKBEHIND;
+ RExC_seen |= REG_LOOKBEHIND_SEEN;
goto finish_meta_pat;
case 'Z':
ret = reg_node(pRExC_state, SEOL);
goto finish_meta_pat;
case 'C':
ret = reg_node(pRExC_state, CANY);
- RExC_seen |= REG_SEEN_CANY;
+ RExC_seen |= REG_CANY_SEEN;
*flagp |= HASWIDTH|SIMPLE;
goto finish_meta_pat;
case 'X':
case 'b':
RExC_seen_zerolen++;
- RExC_seen |= REG_SEEN_LOOKBEHIND;
+ RExC_seen |= REG_LOOKBEHIND_SEEN;
op = BOUND + get_regex_charset(RExC_flags);
if (op > BOUNDA) { /* /aa is same as /a */
op = BOUNDA;
goto finish_meta_pat;
case 'B':
RExC_seen_zerolen++;
- RExC_seen |= REG_SEEN_LOOKBEHIND;
+ RExC_seen |= REG_LOOKBEHIND_SEEN;
op = NBOUND + get_regex_charset(RExC_flags);
if (op > NBOUNDA) { /* /aa is same as /a */
op = NBOUNDA;
*flagp |= HASWIDTH|SIMPLE;
/* FALL THROUGH */
- finish_meta_pat:
+ finish_meta_pat:
nextchar(pRExC_state);
Set_Node_Length(ret, 2); /* MJD */
- break;
+ break;
case 'p':
case 'P':
{
nextchar(pRExC_state);
}
break;
- case 'N':
+ case 'N':
/* Handle \N and \N{NAME} with multiple code points here and not
* below because it can be multicharacter. join_exact() will join
* them up later on. Also this makes sure that things like
break;
case 'k': /* Handle \k<NAME> and \k'NAME' */
parse_named_seq:
- {
- char ch= RExC_parse[1];
+ {
+ char ch= RExC_parse[1];
if (ch != '<' && ch != '\'' && ch != '{') {
RExC_parse++;
+ /* diag_listed_as: Sequence \%s... not terminated in regex; marked by <-- HERE in m/%s/ */
vFAIL2("Sequence %.2s... not terminated",parse_start);
} else {
/* this pretty much dupes the code for (?P=...) in reg(), if
SIZE_ONLY ? REG_RSN_RETURN_NULL : REG_RSN_RETURN_DATA);
ch= (ch == '<') ? '>' : (ch == '{') ? '}' : '\'';
if (RExC_parse == name_start || *RExC_parse != ch)
+ /* diag_listed_as: Sequence \%s... not terminated in regex; marked by <-- HERE in m/%s/ */
vFAIL2("Sequence %.3s... not terminated",parse_start);
if (!SIZE_ONLY) {
}
break;
}
- case 'g':
+ case 'g':
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
{
I32 num;
- bool isg = *RExC_parse == 'g';
- bool isrel = 0;
bool hasbrace = 0;
- if (isg) {
+
+ if (*RExC_parse == 'g') {
+ bool isrel = 0;
+
RExC_parse++;
if (*RExC_parse == '{') {
RExC_parse++;
}
if (hasbrace && !isDIGIT(*RExC_parse)) {
if (isrel) RExC_parse--;
- RExC_parse -= 2;
+ RExC_parse -= 2;
goto parse_named_seq;
- } }
- num = atoi(RExC_parse);
- if (isg && num == 0) {
- if (*RExC_parse == '0') {
+ }
+
+ num = S_backref_value(RExC_parse);
+ if (num == 0)
vFAIL("Reference to invalid group 0");
+ else if (num == I32_MAX) {
+ if (isDIGIT(*RExC_parse))
+ vFAIL("Reference to nonexistent group");
+ else
+ vFAIL("Unterminated \\g... pattern");
}
- else {
- vFAIL("Unterminated \\g... pattern");
+
+ if (isrel) {
+ num = RExC_npar - num;
+ if (num < 1)
+ vFAIL("Reference to nonexistent or unclosed group");
}
}
- if (isrel) {
- num = RExC_npar - num;
- if (num < 1)
- vFAIL("Reference to nonexistent or unclosed group");
+ else {
+ num = S_backref_value(RExC_parse);
+ /* bare \NNN might be backref or octal */
+ if (num == I32_MAX || (num > 9 && num >= RExC_npar
+ && *RExC_parse != '8' && *RExC_parse != '9'))
+ /* Probably a character specified in octal, e.g. \35 */
+ goto defchar;
}
- if (!isg && num > 9 && num >= RExC_npar && *RExC_parse != '8' && *RExC_parse != '9')
- /* Probably a character specified in octal, e.g. \35 */
- goto defchar;
- else {
+
+ /* at this point RExC_parse definitely points to a backref
+ * number */
+ {
#ifdef RE_TRACK_PATTERN_OFFSETS
char * const parse_start = RExC_parse - 1; /* MJD */
#endif
while (isDIGIT(*RExC_parse))
RExC_parse++;
if (hasbrace) {
- if (*RExC_parse != '}')
+ if (*RExC_parse != '}')
vFAIL("Unterminated \\g{...} pattern");
RExC_parse++;
- }
+ }
if (!SIZE_ONLY) {
if (num > (I32)RExC_rx->nparens)
vFAIL("Reference to nonexistent group");
char foldbuf[MAX_NODE_STRING_SIZE+UTF8_MAXBYTES_CASE];
char *s0;
U8 upper_parse = MAX_NODE_STRING_SIZE;
- STRLEN foldlen;
U8 node_type = compute_EXACTish(pRExC_state);
bool next_is_quantifier;
char * oldp = NULL;
/* We can convert EXACTF nodes to EXACTFU if they contain only
* characters that match identically regardless of the target
* string's UTF8ness. The reason to do this is that EXACTF is not
- * trie-able, EXACTFU is. (We don't need to figure this out until
- * pass 2) */
- bool maybe_exactfu = node_type == EXACTF && PASS2;
+ * trie-able, EXACTFU is.
+ *
+ * Similarly, we can convert EXACTFL nodes to EXACTFU if they
+ * contain only above-Latin1 characters (hence must be in UTF8),
+ * which don't participate in folds with Latin1-range characters,
+ * as the latter's folds aren't known until runtime. (We don't
+ * need to figure this out until pass 2) */
+ bool maybe_exactfu = PASS2
+ && (node_type == EXACTF || node_type == EXACTFL);
/* If a folding node contains only code points that don't
* participate in folds, it can be changed into an EXACT node,
reparse:
- /* We do the EXACTFish to EXACT node only if folding, and not if in
- * locale, as whether a character folds or not isn't known until
- * runtime. (And we don't need to figure this out until pass 2) */
- maybe_exact = FOLD && ! LOC && PASS2;
+ /* We do the EXACTFish to EXACT node only if folding. (And we
+ * don't need to figure this out until pass 2) */
+ maybe_exact = FOLD && PASS2;
/* XXX The node can hold up to 255 bytes, yet this only goes to
* 127. I (khw) do not know why. Keeping it somewhat less than
case 's': case 'S': /* space class */
case 'v': case 'V': /* VERTWS */
case 'w': case 'W': /* word class */
- case 'X': /* eXtended Unicode "combining character sequence" */
+ case 'X': /* eXtended Unicode "combining
+ character sequence" */
case 'z': case 'Z': /* End of line/string assertion */
--p;
goto loopdone;
* 118 OR as "\11" . "8" depending on whether there
* were 118 capture buffers defined already in the
* pattern. */
- if ( !isDIGIT(p[1]) || atoi(p) <= RExC_npar )
+ if ( !isDIGIT(p[1]) || S_backref_value(p) <= RExC_npar)
{ /* Not to be treated as an octal constant, go
find backref */
--p;
goto loopdone;
}
- if (! FOLD) {
+ if (! FOLD /* The simple case, just append the literal */
+ || (LOC /* Also don't fold for tricky chars under /l */
+ && is_PROBLEMATIC_LOCALE_FOLD_cp(ender)))
+ {
if (UTF) {
const STRLEN unilen = reguni(pRExC_state, ender, s);
if (unilen > 0) {
else {
REGC((char)ender, s++);
}
+
+ /* Can get here if folding only if is one of the /l
+ * characters whose fold depends on the locale. The
+ * occurrence of any of these indicate that we can't
+ * simplify things */
+ if (FOLD) {
+ maybe_exact = FALSE;
+ maybe_exactfu = FALSE;
+ }
}
- else /* FOLD */ if (! ( UTF
+ else /* FOLD */
+ if (! ( UTF
/* See comments for join_exact() as to why we fold this
* non-UTF at compile time */
|| (node_type == EXACTFU
&& ender == LATIN_SMALL_LETTER_SHARP_S)))
{
+ /* Here, are folding and are not UTF-8 encoded; therefore
+ * the character must be in the range 0-255, and is not /l
+ * (Not /l because we already handled these under /l in
+ * is_PROBLEMATIC_LOCALE_FOLD_cp */
if (IS_IN_SOME_FOLD_L1(ender)) {
maybe_exact = FALSE;
|| ender == LATIN_SMALL_LETTER_SHARP_S
|| (len > 0
&& isARG2_lower_or_UPPER_ARG1('s', ender)
- && isARG2_lower_or_UPPER_ARG1('s', *(s-1)))))
+ && isARG2_lower_or_UPPER_ARG1('s',
+ *(s-1)))))
{
maybe_exactfu = FALSE;
}
}
+
+ /* Even when folding, we store just the input character, as
+ * we have an array that finds its fold quickly */
*(s++) = (char) ender;
}
- else { /* UTF */
-
- /* Prime the casefolded buffer. Locale rules, which apply
- * only to code points < 256, aren't known until execution,
- * so for them, just output the original character using
- * utf8. If we start to fold non-UTF patterns, be sure to
- * update join_exact() */
- if (LOC && ender < 256) {
- if (UVCHR_IS_INVARIANT(ender)) {
- *s = (U8) ender;
- foldlen = 1;
- } else {
- *s = UTF8_TWO_BYTE_HI(ender);
- *(s + 1) = UTF8_TWO_BYTE_LO(ender);
- foldlen = 2;
- }
+ else { /* FOLD and UTF */
+ /* Unlike the non-fold case, we do actually have to
+ * calculate the results here in pass 1. This is for two
+ * reasons, the folded length may be longer than the
+ * unfolded, and we have to calculate how many EXACTish
+ * nodes it will take; and we may run out of room in a node
+ * in the middle of a potential multi-char fold, and have
+ * to back off accordingly. (Hence we can't use REGC for
+ * the simple case just below.) */
+
+ UV folded;
+ if (isASCII(ender)) {
+ folded = toFOLD(ender);
+ *(s)++ = (U8) folded;
}
else {
- UV folded = _to_uni_fold_flags(
- ender,
- (U8 *) s,
- &foldlen,
- FOLD_FLAGS_FULL
- | ((LOC) ? FOLD_FLAGS_LOCALE
- : (ASCII_FOLD_RESTRICTED)
- ? FOLD_FLAGS_NOMIX_ASCII
- : 0)
- );
-
- /* If this node only contains non-folding code points
- * so far, see if this new one is also non-folding */
- if (maybe_exact) {
- if (folded != ender) {
+ STRLEN foldlen;
+
+ folded = _to_uni_fold_flags(
+ ender,
+ (U8 *) s,
+ &foldlen,
+ FOLD_FLAGS_FULL | ((ASCII_FOLD_RESTRICTED)
+ ? FOLD_FLAGS_NOMIX_ASCII
+ : 0));
+ s += foldlen;
+
+ /* The loop increments <len> each time, as all but this
+ * path (and one other) through it add a single byte to
+ * the EXACTish node. But this one has changed len to
+ * be the correct final value, so subtract one to
+ * cancel out the increment that follows */
+ len += foldlen - 1;
+ }
+ /* If this node only contains non-folding code points so
+ * far, see if this new one is also non-folding */
+ if (maybe_exact) {
+ if (folded != ender) {
+ maybe_exact = FALSE;
+ }
+ else {
+ /* Here the fold is the original; we have to check
+ * further to see if anything folds to it */
+ if (_invlist_contains_cp(PL_utf8_foldable,
+ ender))
+ {
maybe_exact = FALSE;
}
- else {
- /* Here the fold is the original; we have
- * to check further to see if anything
- * folds to it */
- if (! PL_utf8_foldable) {
- SV* swash = swash_init("utf8",
- "_Perl_Any_Folds",
- &PL_sv_undef, 1, 0);
- PL_utf8_foldable =
- _get_swash_invlist(swash);
- SvREFCNT_dec_NN(swash);
- }
- if (_invlist_contains_cp(PL_utf8_foldable,
- ender))
- {
- maybe_exact = FALSE;
- }
- }
}
- ender = folded;
}
- s += foldlen;
-
- /* The loop increments <len> each time, as all but this
- * path (and one other) through it add a single byte to the
- * EXACTish node. But this one has changed len to be the
- * correct final value, so subtract one to cancel out the
- * increment that follows */
- len += foldlen - 1;
+ ender = folded;
}
if (next_is_quantifier) {
if (! UTF) {
- /* These two have no multi-char folds to non-UTF characters
- */
- if (ASCII_FOLD_RESTRICTED || LOC) {
+ /* This has no multi-char folds to non-UTF characters */
+ if (ASCII_FOLD_RESTRICTED) {
goto loopdone;
}
}
}
else if (UTF8_IS_DOWNGRADEABLE_START(*s)) {
-
- /* No Latin1 characters participate in multi-char
- * folds under /l */
- if (LOC
- || ! IS_NON_FINAL_FOLD(TWO_BYTE_UTF8_TO_NATIVE(
+ if (! IS_NON_FINAL_FOLD(TWO_BYTE_UTF8_TO_NATIVE(
*s, *(s+1))))
{
break;
* code points in the node that participate in folds;
* similarly for 'maybe_exactfu' and code points that match
* differently depending on UTF8ness of the target string
- * */
+ * (for /u), or depending on locale for /l */
if (maybe_exact) {
OP(ret) = EXACT;
}
}
} while (p < e);
if (!ended)
- RExC_seen |= REG_SEEN_RUN_ON_COMMENT;
+ RExC_seen |= REG_RUN_ON_COMMENT_SEEN;
}
else
break;
/* Returns the next non-pattern-white space, non-comment character (the
* latter only if 'recognize_comment is true) in the string p, which is
* ended by RExC_end. If there is no line break ending a comment,
- * RExC_seen has added the REG_SEEN_RUN_ON_COMMENT flag; */
+ * RExC_seen has added the REG_RUN_ON_COMMENT_SEEN flag; */
const char *e = RExC_end;
PERL_ARGS_ASSERT_REGPATWS;
}
} while (p < e);
if (!ended)
- RExC_seen |= REG_SEEN_RUN_ON_COMMENT;
+ RExC_seen |= REG_RUN_ON_COMMENT_SEEN;
}
else
break;
invlist_iterfinish(*invlist_ptr);
/* Done with loop; remove any code points that are in the bitmap from
- * *invlist_ptr; similarly for code points above latin1 if we have a flag
- * to match all of them anyways */
+ * *invlist_ptr; similarly for code points above latin1 if we have a
+ * flag to match all of them anyways */
if (change_invlist) {
_invlist_subtract(*invlist_ptr, PL_Latin1, invlist_ptr);
}
}
STATIC regnode *
-S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, I32 *flagp, U32 depth,
- char * const oregcomp_parse)
+S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist,
+ I32 *flagp, U32 depth,
+ char * const oregcomp_parse)
{
/* Handle the (?[...]) construct to do set operations */
packWARN(WARN_EXPERIMENTAL__REGEX_SETS),
"The regex_sets feature is experimental" REPORT_LOCATION,
UTF8fARG(UTF, (RExC_parse - RExC_precomp), RExC_precomp),
- UTF8fARG(UTF, RExC_end - RExC_start - (RExC_parse - RExC_precomp), RExC_precomp + (RExC_parse - RExC_precomp)));
+ UTF8fARG(UTF,
+ RExC_end - RExC_start - (RExC_parse - RExC_precomp),
+ RExC_precomp + (RExC_parse - RExC_precomp)));
while (RExC_parse < RExC_end) {
SV* current = NULL;
/* The names of properties whose definitions are not known at compile time are
* stored in this SV, after a constant heading. So if the length has been
* changed since initialization, then there is a run-time definition. */
-#define HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION (SvCUR(listsv) != initial_listsv_len)
+#define HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION \
+ (SvCUR(listsv) != initial_listsv_len)
STATIC regnode *
S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
STRLEN initial_listsv_len = 0; /* Kind of a kludge to see if it is more
than just initialized. */
SV* properties = NULL; /* Code points that match \p{} \P{} */
- SV* posixes = NULL; /* Code points that match classes like, [:word:],
- extended beyond the Latin1 range */
+ SV* posixes = NULL; /* Code points that match classes like [:word:],
+ extended beyond the Latin1 range. These have to
+ be kept separate from other code points for much
+ of this function because their handling is
+ different under /i, and for most classes under
+ /d as well */
+ SV* nposixes = NULL; /* Similarly for [:^word:]. These are kept
+ separate for a while from the non-complemented
+ versions because of complications with /d
+ matching */
UV element_count = 0; /* Number of distinct elements in the class.
Optimizations may be possible if this is tiny */
AV * multi_char_matches = NULL; /* Code points that fold to more than one
* string is in UTF-8. (Because is under /d) */
SV* depends_list = NULL;
- /* inversion list of code points this node matches. For much of the
- * function, it includes only those that match regardless of the utf8ness
- * of the target string */
+ /* Inversion list of code points this node matches regardless of things
+ * like locale, folding, utf8ness of the target string */
SV* cp_list = NULL;
+ /* Like cp_list, but code points on this list need to be checked for things
+ * that fold to/from them under /i */
+ SV* cp_foldable_list = NULL;
+
#ifdef EBCDIC
/* In a range, counts how many 0-2 of the ends of it came from literals,
* not escapes. Thus we can tell if 'A' was input vs \x{C1} */
#endif
bool invert = FALSE; /* Is this class to be complemented */
- /* Is there any thing like \W or [:^digit:] that matches above the legal
- * Unicode range? */
- bool runtime_posix_matches_above_Unicode = FALSE;
+ bool warn_super = ALWAYS_WARN_SUPER;
regnode * const orig_emit = RExC_emit; /* Save the original RExC_emit in
case we need to change the emitted regop to an EXACT. */
case 'H': namedclass = ANYOF_NHORIZWS; break;
case 'N': /* Handle \N{NAME} in class */
{
- /* We only pay attention to the first char of
+ /* We only pay attention to the first char of
multichar strings being returned. I kinda wonder
if this makes sense as it does change the behaviour
from earlier versions, OTOH that behaviour was broken
char *e;
/* We will handle any undefined properties ourselves */
- U8 swash_init_flags = _CORE_SWASH_INIT_RETURN_IF_UNDEF;
+ U8 swash_init_flags = _CORE_SWASH_INIT_RETURN_IF_UNDEF
+ /* And we actually would prefer to get
+ * the straight inversion list of the
+ * swash, since we will be accessing it
+ * anyway, to save a little time */
+ |_CORE_SWASH_INIT_ACCEPT_INVLIST;
if (RExC_parse >= RExC_end)
vFAIL2("Empty \\%c{}", (U8)value);
* would cause things in <depends_list> to match
* inappropriately, except that any \p{}, including
* this one forces Unicode semantics, which means there
- * is <no depends_list> */
+ * is no <depends_list> */
ANYOF_FLAGS(ret) |= ANYOF_NONBITMAP_NON_UTF8;
}
else {
/* Here, did get the swash and its inversion list. If
* the swash is from a user-defined property, then this
* whole character class should be regarded as such */
- has_user_defined_property =
- (swash_init_flags
- & _CORE_SWASH_INIT_USER_DEFINED_PROPERTY);
+ if (swash_init_flags
+ & _CORE_SWASH_INIT_USER_DEFINED_PROPERTY)
+ {
+ has_user_defined_property = TRUE;
+ }
+ else if
+ /* We warn on matching an above-Unicode code point
+ * if the match would return true, except don't
+ * warn for \p{All}, which has exactly one element
+ * = 0 */
+ (_invlist_contains_cp(invlist, 0x110000)
+ && (! (_invlist_len(invlist) == 1
+ && *invlist_array(invlist) == 0)))
+ {
+ warn_super = TRUE;
+ }
+
/* Invert if asking for the complement */
if (value == 'P') {
* space will contain a bit for each named class that is to be matched
* against. This isn't needed for \p{} and pseudo-classes, as they are
* not affected by locale, and hence are dealt with separately */
- if (LOC
- && ! need_class
- && (ANYOF_LOCALE == ANYOF_POSIXL
- || (namedclass > OOB_NAMEDCLASS
- && namedclass < ANYOF_POSIXL_MAX)))
- {
- need_class = 1;
- if (SIZE_ONLY) {
- RExC_size += ANYOF_POSIXL_SKIP - ANYOF_SKIP;
+ if (LOC) {
+ if (FOLD && ! need_class) {
+ need_class = 1;
+ if (SIZE_ONLY) {
+ RExC_size += ANYOF_POSIXL_FOLD_SKIP - ANYOF_SKIP;
+ }
+ else {
+ RExC_emit += ANYOF_POSIXL_FOLD_SKIP - ANYOF_SKIP;
+ }
+
+ /* We need to initialize this here because this node type has
+ * this field, and will skip getting initialized when we get to
+ * a posix class since are doing it here */
+ ANYOF_POSIXL_ZERO(ret);
}
- else {
- RExC_emit += ANYOF_POSIXL_SKIP - ANYOF_SKIP;
+ if (ANYOF_LOCALE == ANYOF_POSIXL
+ || (namedclass > OOB_NAMEDCLASS
+ && namedclass < ANYOF_POSIXL_MAX))
+ {
+ if (! need_class) {
+ need_class = 1;
+ if (SIZE_ONLY) {
+ RExC_size += ANYOF_POSIXL_SKIP - ANYOF_SKIP;
+ }
+ else {
+ RExC_emit += ANYOF_POSIXL_SKIP - ANYOF_SKIP;
+ }
+ ANYOF_POSIXL_ZERO(ret);
+ }
+ ANYOF_FLAGS(ret) |= ANYOF_POSIXL;
}
- ANYOF_POSIXL_ZERO(ret);
- ANYOF_FLAGS(ret) |= ANYOF_POSIXL;
}
if (namedclass > OOB_NAMEDCLASS) { /* this is a named class \blah */
UTF8fARG(UTF, w, rangebegin));
(void)ReREFCNT_inc(RExC_rx_sv);
cp_list = add_cp_to_invlist(cp_list, '-');
- cp_list = add_cp_to_invlist(cp_list, prevvalue);
+ cp_foldable_list = add_cp_to_invlist(cp_foldable_list,
+ prevvalue);
}
}
&& classnum != _CC_BLANK
#endif
) {
+
+ /* See if it already matches the complement of this POSIX
+ * class */
if ((ANYOF_FLAGS(ret) & ANYOF_POSIXL)
&& ANYOF_POSIXL_TEST(ret, namedclass + ((namedclass % 2)
? -1
: 1)))
{
posixl_matches_all = TRUE;
- break;
+ break; /* No need to continue. Since it matches both
+ e.g., \w and \W, it matches everything, and the
+ bracketed class can be optimized into qr/./s */
}
+
+ /* Add this class to those that should be checked at runtime */
ANYOF_POSIXL_SET(ret, namedclass);
+
+ /* The above-Latin1 characters are not subject to locale rules.
+ * Just add them, in the second pass, to the
+ * unconditionally-matched list */
+ if (! SIZE_ONLY) {
+ SV* scratch_list = NULL;
+
+ /* Get the list of the above-Latin1 code points this
+ * matches */
+ _invlist_intersection_maybe_complement_2nd(PL_AboveLatin1,
+ PL_XPosix_ptrs[classnum],
+
+ /* Odd numbers are complements, like
+ * NDIGIT, NASCII, ... */
+ namedclass % 2 != 0,
+ &scratch_list);
+ /* Checking if 'cp_list' is NULL first saves an extra
+ * clone. Its reference count will be decremented at the
+ * next union, etc, or if this is the only instance, at the
+ * end of the routine */
+ if (! cp_list) {
+ cp_list = scratch_list;
+ }
+ else {
+ _invlist_union(cp_list, scratch_list, &cp_list);
+ SvREFCNT_dec_NN(scratch_list);
+ }
+ continue; /* Go get next character */
+ }
}
- /* XXX After have made all the posix classes known at compile time
- * we can move the LOC handling below to above */
+ else if (! SIZE_ONLY) {
- if (! SIZE_ONLY) {
+ /* Here, not in pass1 (in that pass we skip calculating the
+ * contents of this class), and is /l, or is a POSIX class for
+ * which /l doesn't matter (or is a Unicode property, which is
+ * skipped here). */
if (namedclass >= ANYOF_POSIXL_MAX) { /* If a special class */
if (namedclass != ANYOF_UNIPROP) { /* UNIPROP = \p and \P */
- /* Here, should be \h, \H, \v, or \V. Neither /d nor
- * /l make a difference in what these match. There
- * would be problems if these characters had folds
- * other than themselves, as cp_list is subject to
- * folding. */
+ /* Here, should be \h, \H, \v, or \V. None of /d, /i
+ * nor /l make a difference in what these match,
+ * therefore we just add what they match to cp_list. */
if (classnum != _CC_VERTSPACE) {
assert( namedclass == ANYOF_HORIZWS
|| namedclass == ANYOF_NHORIZWS);
_invlist_union_maybe_complement_2nd(
cp_list,
PL_XPosix_ptrs[classnum],
- cBOOL(namedclass % 2), /* Complement if odd
+ namedclass % 2 != 0, /* Complement if odd
(NHORIZWS, NVERTWS)
*/
&cp_list);
}
}
- else if (classnum == _CC_ASCII) {
-#ifdef HAS_ISASCII
- if (LOC) {
- ANYOF_POSIXL_SET(ret, namedclass);
- }
- else
-#endif /* Not isascii(); just use the hard-coded definition for it */
- _invlist_union_maybe_complement_2nd(
- posixes,
- PL_Posix_ptrs[_CC_ASCII],
- cBOOL(namedclass % 2), /* Complement if odd
- (NASCII) */
- &posixes);
- }
- else { /* Garden variety class */
-
- /* The ascii range inversion list */
- SV* ascii_source = PL_Posix_ptrs[classnum];
-
- /* The full Latin1 range inversion list */
- SV* l1_source = PL_L1Posix_ptrs[classnum];
-
- /* This code is structured into two major clauses. The
- * first is for classes whose complete definitions may not
- * already be known. If not, the Latin1 definition
- * (guaranteed to already known) is used plus code is
- * generated to load the rest at run-time (only if needed).
- * If the complete definition is known, it drops down to
- * the second clause, where the complete definition is
- * known */
-
- if (classnum < _FIRST_NON_SWASH_CC) {
-
- /* Here, the class has a swash, which may or not
- * already be loaded */
-
- /* The name of the property to use to match the full
- * eXtended Unicode range swash for this character
- * class */
- const char *Xname = swash_property_names[classnum];
-
- /* If returning the inversion list, we can't defer
- * getting this until runtime */
- if (ret_invlist && ! PL_utf8_swash_ptrs[classnum]) {
- PL_utf8_swash_ptrs[classnum] =
- _core_swash_init("utf8", Xname, &PL_sv_undef,
- 1, /* binary */
- 0, /* not tr/// */
- NULL, /* No inversion list */
- NULL /* No flags */
- );
- assert(PL_utf8_swash_ptrs[classnum]);
- }
- if ( ! PL_utf8_swash_ptrs[classnum]) {
- if (namedclass % 2 == 0) { /* A non-complemented
- class */
- /* If not /a matching, there are code points we
- * don't know at compile time. Arrange for the
- * unknown matches to be loaded at run-time, if
- * needed */
- if (! AT_LEAST_ASCII_RESTRICTED) {
- Perl_sv_catpvf(aTHX_ listsv, "+utf8::%s\n",
- Xname);
- }
- if (LOC) { /* Under locale, set run-time
- lookup */
- ANYOF_POSIXL_SET(ret, namedclass);
- }
- else {
- /* Add the current class's code points to
- * the running total */
- _invlist_union(posixes,
- (AT_LEAST_ASCII_RESTRICTED)
- ? ascii_source
- : l1_source,
- &posixes);
- }
- }
- else { /* A complemented class */
- if (AT_LEAST_ASCII_RESTRICTED) {
- /* Under /a should match everything above
- * ASCII, plus the complement of the set's
- * ASCII matches */
- _invlist_union_complement_2nd(posixes,
- ascii_source,
- &posixes);
- }
- else {
- /* Arrange for the unknown matches to be
- * loaded at run-time, if needed */
- Perl_sv_catpvf(aTHX_ listsv, "!utf8::%s\n",
- Xname);
- runtime_posix_matches_above_Unicode = TRUE;
- if (LOC) {
- ANYOF_POSIXL_SET(ret, namedclass);
- }
- else {
-
- /* We want to match everything in
- * Latin1, except those things that
- * l1_source matches */
- SV* scratch_list = NULL;
- _invlist_subtract(PL_Latin1, l1_source,
- &scratch_list);
-
- /* Add the list from this class to the
- * running total */
- if (! posixes) {
- posixes = scratch_list;
- }
- else {
- _invlist_union(posixes,
- scratch_list,
- &posixes);
- SvREFCNT_dec_NN(scratch_list);
- }
- if (DEPENDS_SEMANTICS) {
- ANYOF_FLAGS(ret)
- |= ANYOF_NON_UTF8_LATIN1_ALL;
- }
- }
- }
- }
- goto namedclass_done;
- }
-
- /* Here, there is a swash loaded for the class. If no
- * inversion list for it yet, get it */
- if (! PL_XPosix_ptrs[classnum]) {
- PL_XPosix_ptrs[classnum]
- = _swash_to_invlist(PL_utf8_swash_ptrs[classnum]);
- }
- }
-
- /* Here there is an inversion list already loaded for the
- * entire class */
-
- if (namedclass % 2 == 0) { /* A non-complemented class,
- like ANYOF_PUNCT */
- if (! LOC) {
- /* For non-locale, just add it to any existing list
- * */
- _invlist_union(posixes,
- (AT_LEAST_ASCII_RESTRICTED)
- ? ascii_source
- : PL_XPosix_ptrs[classnum],
- &posixes);
- }
- else { /* Locale */
- SV* scratch_list = NULL;
-
- /* For above Latin1 code points, we use the full
- * Unicode range */
- _invlist_intersection(PL_AboveLatin1,
- PL_XPosix_ptrs[classnum],
- &scratch_list);
- /* And set the output to it, adding instead if
- * there already is an output. Checking if
- * 'posixes' is NULL first saves an extra clone.
- * Its reference count will be decremented at the
- * next union, etc, or if this is the only
- * instance, at the end of the routine */
- if (! posixes) {
- posixes = scratch_list;
- }
- else {
- _invlist_union(posixes, scratch_list, &posixes);
- SvREFCNT_dec_NN(scratch_list);
- }
-
+ else { /* Garden variety class. If is NASCII, NDIGIT, ...
+ complement and use nposixes */
+ SV** posixes_ptr = namedclass % 2 == 0
+ ? &posixes
+ : &nposixes;
+ SV** source_ptr = &PL_XPosix_ptrs[classnum];
#ifndef HAS_ISBLANK
- if (namedclass != ANYOF_BLANK) {
-#endif
- /* Set this class in the node for runtime
- * matching */
- ANYOF_POSIXL_SET(ret, namedclass);
-#ifndef HAS_ISBLANK
- }
- else {
- /* No isblank(), use the hard-coded ASCII-range
- * blanks, adding them to the running total. */
-
- _invlist_union(posixes, ascii_source, &posixes);
- }
-#endif
- }
+ /* If the platform doesn't have isblank(), we handle locale
+ * with the hardcoded ASII values. */
+ if (LOC && classnum == _CC_BLANK) {
+ _invlist_subtract(*source_ptr,
+ PL_UpperLatin1,
+ source_ptr);
}
- else { /* A complemented class, like ANYOF_NPUNCT */
- if (! LOC) {
- _invlist_union_complement_2nd(
- posixes,
- (AT_LEAST_ASCII_RESTRICTED)
- ? ascii_source
- : PL_XPosix_ptrs[classnum],
- &posixes);
- /* Under /d, everything in the upper half of the
- * Latin1 range matches this complement */
- if (DEPENDS_SEMANTICS) {
- ANYOF_FLAGS(ret) |= ANYOF_NON_UTF8_LATIN1_ALL;
- }
- }
- else { /* Locale */
- SV* scratch_list = NULL;
- _invlist_subtract(PL_AboveLatin1,
- PL_XPosix_ptrs[classnum],
- &scratch_list);
- if (! posixes) {
- posixes = scratch_list;
- }
- else {
- _invlist_union(posixes, scratch_list, &posixes);
- SvREFCNT_dec_NN(scratch_list);
- }
-#ifndef HAS_ISBLANK
- if (namedclass != ANYOF_NBLANK) {
#endif
- ANYOF_POSIXL_SET(ret, namedclass);
-#ifndef HAS_ISBLANK
- }
- else {
- /* Get the list of all code points in Latin1
- * that are not ASCII blanks, and add them to
- * the running total */
- _invlist_subtract(PL_Latin1, ascii_source,
- &scratch_list);
- _invlist_union(posixes, scratch_list, &posixes);
- SvREFCNT_dec_NN(scratch_list);
- }
-#endif
- }
- }
+
+ _invlist_union_maybe_complement_2nd(
+ *posixes_ptr,
+ *source_ptr,
+ namedclass % 2 != 0,
+ posixes_ptr);
}
- namedclass_done:
- continue; /* Go get next character */
+ continue; /* Go get next character */
}
} /* end of namedclass \blah */
value,
foldbuf,
&foldlen,
- FOLD_FLAGS_FULL
- | ((LOC) ? FOLD_FLAGS_LOCALE
- : (ASCII_FOLD_RESTRICTED)
- ? FOLD_FLAGS_NOMIX_ASCII
- : 0)
+ FOLD_FLAGS_FULL | (ASCII_FOLD_RESTRICTED
+ ? FOLD_FLAGS_NOMIX_ASCII
+ : 0)
);
/* Here, <folded> should be the first character of the
/* Deal with this element of the class */
if (! SIZE_ONLY) {
#ifndef EBCDIC
- cp_list = _add_range_to_invlist(cp_list, prevvalue, value);
+ cp_foldable_list = _add_range_to_invlist(cp_foldable_list,
+ prevvalue, value);
#else
SV* this_range = _new_invlist(1);
_append_range_to_invlist(this_range, prevvalue, value);
{
_invlist_intersection(this_range, PL_ASCII,
&this_range);
- _invlist_intersection(this_range, PL_Posix_ptrs[_CC_ALPHA],
+
+ /* Since this above only contains ascii, the intersection of it
+ * with anything will still yield only ascii */
+ _invlist_intersection(this_range, PL_XPosix_ptrs[_CC_ALPHA],
&this_range);
}
- _invlist_union(cp_list, this_range, &cp_list);
+ _invlist_union(cp_foldable_list, this_range, &cp_foldable_list);
literal_endpoint = 0;
#endif
}
return ret;
}
- /* If the character class contains only a single element, it may be
- * optimizable into another node type which is smaller and runs faster.
- * Check if this is the case for this class */
- if ((element_count == 1 && ! ret_invlist)
- || UNLIKELY(posixl_matches_all))
+ /* Here, we've gone through the entire class and dealt with multi-char
+ * folds. We are now in a position that we can do some checks to see if we
+ * can optimize this ANYOF node into a simpler one, even in Pass 1.
+ * Currently we only do two checks:
+ * 1) is in the unlikely event that the user has specified both, eg. \w and
+ * \W under /l, then the class matches everything. (This optimization
+ * is done only to make the optimizer code run later work.)
+ * 2) if the character class contains only a single element (including a
+ * single range), we see if there is an equivalent node for it.
+ * Other checks are possible */
+ if (! ret_invlist /* Can't optimize if returning the constructed
+ inversion list */
+ && (UNLIKELY(posixl_matches_all) || element_count == 1))
{
U8 op = END;
U8 arg = 0;
RExC_parse = (char *) cur_parse;
SvREFCNT_dec(posixes);
+ SvREFCNT_dec(nposixes);
SvREFCNT_dec(cp_list);
+ SvREFCNT_dec(cp_foldable_list);
return ret;
}
}
/* If folding, we calculate all characters that could fold to or from the
* ones already on the list */
- if (FOLD && cp_list) {
- UV start, end; /* End points of code point ranges */
+ if (cp_foldable_list) {
+ if (FOLD) {
+ UV start, end; /* End points of code point ranges */
+
+ SV* fold_intersection = NULL;
+ SV** use_list;
+
+ /* Our calculated list will be for Unicode rules. For locale
+ * matching, we have to keep a separate list that is consulted at
+ * runtime only when the locale indicates Unicode rules. For
+ * non-locale, we just use to the general list */
+ if (LOC) {
+ use_list = &ANYOF_UTF8_LOCALE_INVLIST(ret);
+ *use_list = NULL;
+ }
+ else {
+ use_list = &cp_list;
+ }
- SV* fold_intersection = NULL;
+ /* Only the characters in this class that participate in folds need
+ * be checked. Get the intersection of this class and all the
+ * possible characters that are foldable. This can quickly narrow
+ * down a large class */
+ _invlist_intersection(PL_utf8_foldable, cp_foldable_list,
+ &fold_intersection);
- /* If the highest code point is within Latin1, we can use the
- * compiled-in Alphas list, and not have to go out to disk. This
- * yields two false positives, the masculine and feminine ordinal
- * indicators, which are weeded out below using the
- * IS_IN_SOME_FOLD_L1() macro */
- if (invlist_highest(cp_list) < 256) {
- _invlist_intersection(PL_L1Posix_ptrs[_CC_ALPHA], cp_list,
- &fold_intersection);
- }
- else {
+ /* The folds for all the Latin1 characters are hard-coded into this
+ * program, but we have to go out to disk to get the others. */
+ if (invlist_highest(cp_foldable_list) >= 256) {
+
+ /* This is a hash that for a particular fold gives all
+ * characters that are involved in it */
+ if (! PL_utf8_foldclosures) {
- /* Here, there are non-Latin1 code points, so we will have to go
- * fetch the list of all the characters that participate in folds
- */
- if (! PL_utf8_foldable) {
- SV* swash = swash_init("utf8", "_Perl_Any_Folds",
- &PL_sv_undef, 1, 0);
- PL_utf8_foldable = _get_swash_invlist(swash);
- SvREFCNT_dec_NN(swash);
- }
-
- /* This is a hash that for a particular fold gives all characters
- * that are involved in it */
- if (! PL_utf8_foldclosures) {
-
- /* If we were unable to find any folds, then we likely won't be
- * able to find the closures. So just create an empty list.
- * Folding will effectively be restricted to the non-Unicode
- * rules hard-coded into Perl. (This case happens legitimately
- * during compilation of Perl itself before the Unicode tables
- * are generated) */
- if (_invlist_len(PL_utf8_foldable) == 0) {
- PL_utf8_foldclosures = newHV();
- }
- else {
/* If the folds haven't been read in, call a fold function
* to force that */
if (! PL_utf8_tofold) {
to_utf8_fold((U8*) HYPHEN_UTF8, dummy, NULL);
assert(PL_utf8_tofold); /* Verify that worked */
}
- PL_utf8_foldclosures =
- _swash_inversion_hash(PL_utf8_tofold);
+ PL_utf8_foldclosures
+ = _swash_inversion_hash(PL_utf8_tofold);
}
}
- /* Only the characters in this class that participate in folds need
- * be checked. Get the intersection of this class and all the
- * possible characters that are foldable. This can quickly narrow
- * down a large class */
- _invlist_intersection(PL_utf8_foldable, cp_list,
- &fold_intersection);
- }
-
- /* Now look at the foldable characters in this class individually */
- invlist_iterinit(fold_intersection);
- while (invlist_iternext(fold_intersection, &start, &end)) {
- UV j;
-
- /* Locale folding for Latin1 characters is deferred until runtime */
- if (LOC && start < 256) {
- start = 256;
- }
-
- /* Look at every character in the range */
- for (j = start; j <= end; j++) {
-
- U8 foldbuf[UTF8_MAXBYTES_CASE+1];
- STRLEN foldlen;
- SV** listp;
-
- if (j < 256) {
-
- /* We have the latin1 folding rules hard-coded here so that
- * an innocent-looking character class, like /[ks]/i won't
- * have to go out to disk to find the possible matches.
- * XXX It would be better to generate these via regen, in
- * case a new version of the Unicode standard adds new
- * mappings, though that is not really likely, and may be
- * caught by the default: case of the switch below. */
-
- if (IS_IN_SOME_FOLD_L1(j)) {
-
- /* ASCII is always matched; non-ASCII is matched only
- * under Unicode rules */
- if (isASCII(j) || AT_LEAST_UNI_SEMANTICS) {
- cp_list =
- add_cp_to_invlist(cp_list, PL_fold_latin1[j]);
- }
- else {
- depends_list =
- add_cp_to_invlist(depends_list, PL_fold_latin1[j]);
+ /* Now look at the foldable characters in this class individually */
+ invlist_iterinit(fold_intersection);
+ while (invlist_iternext(fold_intersection, &start, &end)) {
+ UV j;
+
+ /* Look at every character in the range */
+ for (j = start; j <= end; j++) {
+ U8 foldbuf[UTF8_MAXBYTES_CASE+1];
+ STRLEN foldlen;
+ SV** listp;
+
+ if (j < 256) {
+
+ /* We have the latin1 folding rules hard-coded here so
+ * that an innocent-looking character class, like
+ * /[ks]/i won't have to go out to disk to find the
+ * possible matches. XXX It would be better to
+ * generate these via regen, in case a new version of
+ * the Unicode standard adds new mappings, though that
+ * is not really likely, and may be caught by the
+ * default: case of the switch below. */
+
+ if (IS_IN_SOME_FOLD_L1(j)) {
+
+ /* ASCII is always matched; non-ASCII is matched
+ * only under Unicode rules (which could happen
+ * under /l if the locale is a UTF-8 one */
+ if (isASCII(j) || ! DEPENDS_SEMANTICS) {
+ *use_list = add_cp_to_invlist(*use_list,
+ PL_fold_latin1[j]);
+ }
+ else {
+ depends_list =
+ add_cp_to_invlist(depends_list,
+ PL_fold_latin1[j]);
+ }
}
- }
- if (HAS_NONLATIN1_FOLD_CLOSURE(j)
- && (! isASCII(j) || ! ASCII_FOLD_RESTRICTED))
- {
- /* Certain Latin1 characters have matches outside
- * Latin1. To get here, <j> is one of those
- * characters. None of these matches is valid for
- * ASCII characters under /aa, which is why the 'if'
- * just above excludes those. These matches only
- * happen when the target string is utf8. The code
- * below adds the single fold closures for <j> to the
- * inversion list. */
- switch (j) {
- case 'k':
- case 'K':
- cp_list =
- add_cp_to_invlist(cp_list, KELVIN_SIGN);
- break;
- case 's':
- case 'S':
- cp_list = add_cp_to_invlist(cp_list,
+ if (HAS_NONLATIN1_FOLD_CLOSURE(j)
+ && (! isASCII(j) || ! ASCII_FOLD_RESTRICTED))
+ {
+ /* Certain Latin1 characters have matches outside
+ * Latin1. To get here, <j> is one of those
+ * characters. None of these matches is valid for
+ * ASCII characters under /aa, which is why the 'if'
+ * just above excludes those. These matches only
+ * happen when the target string is utf8. The code
+ * below adds the single fold closures for <j> to the
+ * inversion list. */
+
+ switch (j) {
+ case 'k':
+ case 'K':
+ *use_list =
+ add_cp_to_invlist(*use_list, KELVIN_SIGN);
+ break;
+ case 's':
+ case 'S':
+ *use_list = add_cp_to_invlist(*use_list,
LATIN_SMALL_LETTER_LONG_S);
- break;
- case MICRO_SIGN:
- cp_list = add_cp_to_invlist(cp_list,
- GREEK_CAPITAL_LETTER_MU);
- cp_list = add_cp_to_invlist(cp_list,
- GREEK_SMALL_LETTER_MU);
- break;
- case LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE:
- case LATIN_SMALL_LETTER_A_WITH_RING_ABOVE:
- cp_list =
- add_cp_to_invlist(cp_list, ANGSTROM_SIGN);
- break;
- case LATIN_SMALL_LETTER_Y_WITH_DIAERESIS:
- cp_list = add_cp_to_invlist(cp_list,
+ break;
+ case MICRO_SIGN:
+ *use_list = add_cp_to_invlist(*use_list,
+ GREEK_CAPITAL_LETTER_MU);
+ *use_list = add_cp_to_invlist(*use_list,
+ GREEK_SMALL_LETTER_MU);
+ break;
+ case LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE:
+ case LATIN_SMALL_LETTER_A_WITH_RING_ABOVE:
+ *use_list =
+ add_cp_to_invlist(*use_list, ANGSTROM_SIGN);
+ break;
+ case LATIN_SMALL_LETTER_Y_WITH_DIAERESIS:
+ *use_list = add_cp_to_invlist(*use_list,
LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS);
- break;
- case LATIN_SMALL_LETTER_SHARP_S:
- cp_list = add_cp_to_invlist(cp_list,
- LATIN_CAPITAL_LETTER_SHARP_S);
- break;
- case 'F': case 'f':
- case 'I': case 'i':
- case 'L': case 'l':
- case 'T': case 't':
- case 'A': case 'a':
- case 'H': case 'h':
- case 'J': case 'j':
- case 'N': case 'n':
- case 'W': case 'w':
- case 'Y': case 'y':
- /* These all are targets of multi-character
- * folds from code points that require UTF8 to
- * express, so they can't match unless the
- * target string is in UTF-8, so no action here
- * is necessary, as regexec.c properly handles
- * the general case for UTF-8 matching and
- * multi-char folds */
- break;
- default:
- /* Use deprecated warning to increase the
- * chances of this being output */
- ckWARN2reg_d(RExC_parse, "Perl folding rules are not up-to-date for 0x%"UVXf"; please use the perlbug utility to report;", j);
- break;
+ break;
+ case LATIN_SMALL_LETTER_SHARP_S:
+ *use_list = add_cp_to_invlist(*use_list,
+ LATIN_CAPITAL_LETTER_SHARP_S);
+ break;
+ case 'F': case 'f':
+ case 'I': case 'i':
+ case 'L': case 'l':
+ case 'T': case 't':
+ case 'A': case 'a':
+ case 'H': case 'h':
+ case 'J': case 'j':
+ case 'N': case 'n':
+ case 'W': case 'w':
+ case 'Y': case 'y':
+ /* These all are targets of multi-character
+ * folds from code points that require UTF8
+ * to express, so they can't match unless
+ * the target string is in UTF-8, so no
+ * action here is necessary, as regexec.c
+ * properly handles the general case for
+ * UTF-8 matching and multi-char folds */
+ break;
+ default:
+ /* Use deprecated warning to increase the
+ * chances of this being output */
+ ckWARN2reg_d(RExC_parse, "Perl folding rules are not up-to-date for 0x%"UVXf"; please use the perlbug utility to report;", j);
+ break;
+ }
}
+ continue;
}
- continue;
- }
- /* Here is an above Latin1 character. We don't have the rules
- * hard-coded for it. First, get its fold. This is the simple
- * fold, as the multi-character folds have been handled earlier
- * and separated out */
- _to_uni_fold_flags(j, foldbuf, &foldlen,
- ((LOC)
- ? FOLD_FLAGS_LOCALE
- : (ASCII_FOLD_RESTRICTED)
- ? FOLD_FLAGS_NOMIX_ASCII
- : 0));
-
- /* Single character fold of above Latin1. Add everything in
- * its fold closure to the list that this node should match.
- * The fold closures data structure is a hash with the keys
- * being the UTF-8 of every character that is folded to, like
- * 'k', and the values each an array of all code points that
- * fold to its key. e.g. [ 'k', 'K', KELVIN_SIGN ].
- * Multi-character folds are not included */
- if ((listp = hv_fetch(PL_utf8_foldclosures,
- (char *) foldbuf, foldlen, FALSE)))
- {
- AV* list = (AV*) *listp;
- IV k;
- for (k = 0; k <= av_len(list); k++) {
- SV** c_p = av_fetch(list, k, FALSE);
- UV c;
- if (c_p == NULL) {
- Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure");
- }
- c = SvUV(*c_p);
-
- /* /aa doesn't allow folds between ASCII and non-; /l
- * doesn't allow them between above and below 256 */
- if ((ASCII_FOLD_RESTRICTED
- && (isASCII(c) != isASCII(j)))
- || (LOC && c < 256)) {
- continue;
- }
+ /* Here is an above Latin1 character. We don't have the
+ * rules hard-coded for it. First, get its fold. This is
+ * the simple fold, as the multi-character folds have been
+ * handled earlier and separated out */
+ _to_uni_fold_flags(j, foldbuf, &foldlen,
+ (ASCII_FOLD_RESTRICTED)
+ ? FOLD_FLAGS_NOMIX_ASCII
+ : 0);
+
+ /* Single character fold of above Latin1. Add everything in
+ * its fold closure to the list that this node should match.
+ * The fold closures data structure is a hash with the keys
+ * being the UTF-8 of every character that is folded to, like
+ * 'k', and the values each an array of all code points that
+ * fold to its key. e.g. [ 'k', 'K', KELVIN_SIGN ].
+ * Multi-character folds are not included */
+ if ((listp = hv_fetch(PL_utf8_foldclosures,
+ (char *) foldbuf, foldlen, FALSE)))
+ {
+ AV* list = (AV*) *listp;
+ IV k;
+ for (k = 0; k <= av_len(list); k++) {
+ SV** c_p = av_fetch(list, k, FALSE);
+ UV c;
+ if (c_p == NULL) {
+ Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure");
+ }
+ c = SvUV(*c_p);
- /* Folds involving non-ascii Latin1 characters
- * under /d are added to a separate list */
- if (isASCII(c) || c > 255 || AT_LEAST_UNI_SEMANTICS)
- {
- cp_list = add_cp_to_invlist(cp_list, c);
- }
- else {
- depends_list = add_cp_to_invlist(depends_list, c);
+ /* /aa doesn't allow folds between ASCII and non- */
+ if ((ASCII_FOLD_RESTRICTED
+ && (isASCII(c) != isASCII(j))))
+ {
+ continue;
+ }
+
+ /* Folds under /l which cross the 255/256 boundary
+ * are added to a separate list. (These are valid
+ * only when the locale is UTF-8.) */
+ if (c < 256 && LOC) {
+ *use_list = add_cp_to_invlist(*use_list, c);
+ continue;
+ }
+
+ if (isASCII(c) || c > 255 || AT_LEAST_UNI_SEMANTICS)
+ {
+ cp_list = add_cp_to_invlist(cp_list, c);
+ }
+ else {
+ /* Similarly folds involving non-ascii Latin1
+ * characters under /d are added to their list */
+ depends_list = add_cp_to_invlist(depends_list,
+ c);
+ }
}
}
}
}
- }
- SvREFCNT_dec_NN(fold_intersection);
+ SvREFCNT_dec_NN(fold_intersection);
+ }
+
+ /* Now that we have finished adding all the folds, there is no reason
+ * to keep the foldable list separate */
+ _invlist_union(cp_list, cp_foldable_list, &cp_list);
+ SvREFCNT_dec_NN(cp_foldable_list);
}
/* And combine the result (if any) with any inversion list from posix
* classes. The lists are kept separate up to now because we don't want to
* fold the classes (folding of those is automatically handled by the swash
* fetching code) */
- if (posixes) {
+ if (posixes || nposixes) {
+ if (posixes && AT_LEAST_ASCII_RESTRICTED) {
+ /* Under /a and /aa, nothing above ASCII matches these */
+ _invlist_intersection(posixes,
+ PL_XPosix_ptrs[_CC_ASCII],
+ &posixes);
+ }
+ if (nposixes) {
+ if (DEPENDS_SEMANTICS) {
+ /* Under /d, everything in the upper half of the Latin1 range
+ * matches these complements */
+ ANYOF_FLAGS(ret) |= ANYOF_NON_UTF8_NON_ASCII_ALL;
+ }
+ else if (AT_LEAST_ASCII_RESTRICTED) {
+ /* Under /a and /aa, everything above ASCII matches these
+ * complements */
+ _invlist_union_complement_2nd(nposixes,
+ PL_XPosix_ptrs[_CC_ASCII],
+ &nposixes);
+ }
+ if (posixes) {
+ _invlist_union(posixes, nposixes, &posixes);
+ SvREFCNT_dec_NN(nposixes);
+ }
+ else {
+ posixes = nposixes;
+ }
+ }
if (! DEPENDS_SEMANTICS) {
if (cp_list) {
_invlist_union(cp_list, posixes, &cp_list);
* <depends_list>, because having a Unicode property forces Unicode
* semantics */
if (properties) {
- bool warn_super = ! has_user_defined_property;
if (cp_list) {
/* If it matters to the final outcome, see if a non-property
* are using above-Unicode code points indicates they should know
* the issues involved */
if (warn_super) {
- bool non_prop_matches_above_Unicode =
- runtime_posix_matches_above_Unicode
- | (invlist_highest(cp_list) > PERL_UNICODE_MAX);
- if (invert) {
- non_prop_matches_above_Unicode =
- ! non_prop_matches_above_Unicode;
- }
- warn_super = ! non_prop_matches_above_Unicode;
+ warn_super = ! (invert
+ ^ (invlist_highest(cp_list) > PERL_UNICODE_MAX));
}
_invlist_union(properties, cp_list, &cp_list);
}
if (warn_super) {
- OP(ret) = ANYOF_WARN_SUPER;
+ ANYOF_FLAGS(ret) |= ANYOF_WARN_SUPER;
}
}
* shouldn't. Therefore we can't invert folded locale now, as it won't be
* folded until runtime */
+ /* If we didn't do folding, it's because some information isn't available
+ * until runtime; set the run-time fold flag for these. (We don't have to
+ * worry about properties folding, as that is taken care of by the swash
+ * fetching). We know to set the flag if we have a non-NULL list for UTF-8
+ * locales, or the class matches at least one 0-255 range code point */
+ if (LOC && FOLD) {
+ if (ANYOF_UTF8_LOCALE_INVLIST(ret)) {
+ ANYOF_FLAGS(ret) |= ANYOF_LOC_FOLD;
+ }
+ else if (cp_list) { /* Look to see if there a 0-255 code point is in
+ the list */
+ UV start, end;
+ invlist_iterinit(cp_list);
+ if (invlist_iternext(cp_list, &start, &end) && start < 256) {
+ ANYOF_FLAGS(ret) |= ANYOF_LOC_FOLD;
+ }
+ invlist_iterfinish(cp_list);
+ }
+ }
+
/* Optimize inverted simple patterns (e.g. [^a-z]) when everything is known
* at compile time. Besides not inverting folded locale now, we can't
* invert if there are things such as \w, which aren't known until runtime
* */
if (invert
- && ! (LOC && (FOLD || (ANYOF_FLAGS(ret) & ANYOF_POSIXL)))
+ && ! (ANYOF_FLAGS(ret) & (ANYOF_LOC_FOLD|ANYOF_POSIXL))
&& ! depends_list
&& ! HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION)
{
return orig_emit;
}
- /* If we didn't do folding, it's because some information isn't available
- * until runtime; set the run-time fold flag for these. (We don't have to
- * worry about properties folding, as that is taken care of by the swash
- * fetching) */
- if (FOLD && LOC)
- {
- ANYOF_FLAGS(ret) |= ANYOF_LOC_FOLD;
- }
-
/* Some character classes are equivalent to other nodes. Such nodes take
* up less room and generally fewer operations to execute than ANYOF nodes.
* Above, we checked for and optimized into some such equivalents for
if (cp_list
&& ! invert
&& ! depends_list
- && ! (ANYOF_FLAGS(ret) & ANYOF_POSIXL)
- && ! HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION)
+ && ! (ANYOF_FLAGS(ret) & (ANYOF_LOC_FOLD|ANYOF_POSIXL))
+ && ! HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION
+
+ /* We don't optimize if we are supposed to make sure all non-Unicode
+ * code points raise a warning, as only ANYOF nodes have this check.
+ * */
+ && ! ((ANYOF_FLAGS(ret) | ANYOF_WARN_SUPER) && ALWAYS_WARN_SUPER))
{
UV start, end;
U8 op = END; /* The optimzation node-type */
&& (start < 256 || UTF))
{
/* Here, the list contains a single code point. Can optimize
- * into an EXACT node */
+ * into an EXACTish node */
value = start;
}
}
else {
- if (! PL_utf8_foldable) {
- SV* swash = swash_init("utf8", "_Perl_Any_Folds",
- &PL_sv_undef, 1, 0);
- PL_utf8_foldable = _get_swash_invlist(swash);
- SvREFCNT_dec_NN(swash);
- }
if (_invlist_contains_cp(PL_utf8_foldable, value)) {
op = EXACT;
}
Absorbs an /x style # comments from the input stream.
Returns true if there is more text remaining in the stream.
- Will set the REG_SEEN_RUN_ON_COMMENT flag if the comment
+ Will set the REG_RUN_ON_COMMENT_SEEN flag if the comment
terminates the pattern without including a newline.
Note its the callers responsibility to ensure that we are
if (!ended) {
/* we ran off the end of the pattern without ending
the comment, so we have to add an \n when wrapping */
- RExC_seen |= REG_SEEN_RUN_ON_COMMENT;
+ RExC_seen |= REG_RUN_ON_COMMENT_SEEN;
return 0;
} else
return 1;
FILL_ADVANCE_NODE(ptr, op);
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD */
- MJD_OFFSET_DEBUG(("%s:%d: (op %s) %s %"UVuf" (len %"UVuf") (max %"UVuf").\n",
- "reg_node", __LINE__,
+ MJD_OFFSET_DEBUG(
+ ("%s:%d: (op %s) %s %"UVuf" (len %"UVuf") (max %"UVuf").\n",
+ "reg_node", __LINE__,
PL_reg_name[op],
- (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0]
+ (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0]
? "Overwriting end of array!\n" : "OK",
(UV)(RExC_emit - RExC_emit_start),
(UV)(RExC_parse - RExC_start),
- (UV)RExC_offsets[0]));
+ (UV)RExC_offsets[0]));
Set_Node_Offset(RExC_emit, RExC_parse + (op == END));
}
#endif
if (SIZE_ONLY) {
SIZE_ALIGN(RExC_size);
RExC_size += 2;
- /*
+ /*
We can't do this:
-
- assert(2==regarglen[op]+1);
+
+ assert(2==regarglen[op]+1);
Anything larger than this has to allocate the extra amount.
If we changed this to be:
-
+
RExC_size += (1 + regarglen[op]);
-
+
then it wouldn't matter. Its not clear what side effect
might come from that so its not done so far.
-- dmq
FILL_ADVANCE_NODE_ARG(ptr, op, arg);
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD */
- MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
+ MJD_OFFSET_DEBUG(
+ ("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
"reganode",
__LINE__,
PL_reg_name[op],
- (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ?
+ (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ?
"Overwriting end of array!\n" : "OK",
(UV)(RExC_emit - RExC_emit_start),
(UV)(RExC_parse - RExC_start),
- (UV)RExC_offsets[0]));
+ (UV)RExC_offsets[0]));
Set_Cur_Node_Offset;
}
-#endif
+#endif
RExC_emit = ptr;
return(ret);
}
/*
- reguni - emit (if appropriate) a Unicode character
*/
-STATIC STRLEN
+PERL_STATIC_INLINE STRLEN
S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s)
{
dVAR;
StructCopy(--src, --dst, regnode);
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD 20010112 */
- MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s copy %"UVuf" -> %"UVuf" (max %"UVuf").\n",
+ MJD_OFFSET_DEBUG(
+ ("%s(%d): (op %s) %s copy %"UVuf" -> %"UVuf" (max %"UVuf").\n",
"reg_insert",
__LINE__,
PL_reg_name[op],
- (UV)(dst - RExC_emit_start) > RExC_offsets[0]
+ (UV)(dst - RExC_emit_start) > RExC_offsets[0]
? "Overwriting end of array!\n" : "OK",
(UV)(src - RExC_emit_start),
(UV)(dst - RExC_emit_start),
- (UV)RExC_offsets[0]));
+ (UV)RExC_offsets[0]));
Set_Node_Offset_To_R(dst-RExC_emit_start, Node_Offset(src));
Set_Node_Length_To_R(dst-RExC_emit_start, Node_Length(src));
}
#endif
}
-
+
place = opnd; /* Op node, where operand used to be. */
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD */
- MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
+ MJD_OFFSET_DEBUG(
+ ("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
"reginsert",
__LINE__,
PL_reg_name[op],
- (UV)(place - RExC_emit_start) > RExC_offsets[0]
+ (UV)(place - RExC_emit_start) > RExC_offsets[0]
? "Overwriting end of array!\n" : "OK",
(UV)(place - RExC_emit_start),
(UV)(RExC_parse - RExC_start),
Set_Node_Offset(place, RExC_parse);
Set_Node_Length(place, 1);
}
-#endif
+#endif
src = NEXTOPER(place);
FILL_ADVANCE_NODE(place, op);
Zero(src, offset, regnode);
*/
/* TODO: All three parms should be const */
STATIC void
-S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 depth)
+S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p,
+ const regnode *val,U32 depth)
{
dVAR;
regnode *scan;
- Look for optimizable sequences at the same time.
- currently only looks for EXACT chains.
-This is experimental code. The idea is to use this routine to perform
+This is experimental code. The idea is to use this routine to perform
in place optimizations on branches and groups as they are constructed,
with the long term intention of removing optimization from study_chunk so
that it is purely analytical.
/* TODO: All four parms should be const */
STATIC U8
-S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 depth)
+S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p,
+ const regnode *val,U32 depth)
{
dVAR;
regnode *scan;
regnode * const temp = regnext(scan);
#ifdef EXPERIMENTAL_INPLACESCAN
if (PL_regkind[OP(scan)] == EXACT) {
- bool has_exactf_sharp_s; /* Unexamined in this routine */
- if (join_exact(pRExC_state,scan,&min, &has_exactf_sharp_s, 1,val,depth+1))
+ bool unfolded_multi_char; /* Unexamined in this routine */
+ if (join_exact(pRExC_state, scan, &min,
+ &unfolded_multi_char, 1, val, depth+1))
return EXACT;
}
#endif
SV * const mysv_val=sv_newmortal();
DEBUG_PARSE_MSG("");
regprop(RExC_rx, mysv_val, val);
- PerlIO_printf(Perl_debug_log, "~ attach to %s (%"IVdf") offset to %"IVdf"\n",
+ PerlIO_printf(Perl_debug_log,
+ "~ attach to %s (%"IVdf") offset to %"IVdf"\n",
SvPV_nolen_const(mysv_val),
(IV)REG_NODE_NUM(val),
(IV)(val - scan)
}
}
-static void
+static void
S_regdump_extflags(pTHX_ const char *lead, const U32 flags)
{
int bit;
if ((1<<bit) & RXf_PMf_CHARSET) { /* Output separately, below */
continue;
}
- if (!set++ && lead)
+ if (!set++ && lead)
PerlIO_printf(Perl_debug_log, "%s",lead);
PerlIO_printf(Perl_debug_log, "%s ",PL_reg_extflags_name[bit]);
- }
- }
+ }
+ }
if ((cs = get_regex_charset(flags)) != REGEX_DEPENDS_CHARSET) {
if (!set++ && lead) {
PerlIO_printf(Perl_debug_log, "%s",lead);
}
}
if (lead) {
- if (set)
+ if (set)
PerlIO_printf(Perl_debug_log, "\n");
- else
+ else
PerlIO_printf(Perl_debug_log, "%s[none-set]\n",lead);
- }
-}
+ }
+}
#endif
void
/* Header fields of interest. */
if (r->anchored_substr) {
- RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->anchored_substr),
+ RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->anchored_substr),
RE_SV_DUMPLEN(r->anchored_substr), 30);
PerlIO_printf(Perl_debug_log,
"anchored %s%s at %"IVdf" ",
s, RE_SV_TAIL(r->anchored_substr),
(IV)r->anchored_offset);
} else if (r->anchored_utf8) {
- RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->anchored_utf8),
+ RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->anchored_utf8),
RE_SV_DUMPLEN(r->anchored_utf8), 30);
PerlIO_printf(Perl_debug_log,
"anchored utf8 %s%s at %"IVdf" ",
s, RE_SV_TAIL(r->anchored_utf8),
(IV)r->anchored_offset);
- }
+ }
if (r->float_substr) {
- RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->float_substr),
+ RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->float_substr),
RE_SV_DUMPLEN(r->float_substr), 30);
PerlIO_printf(Perl_debug_log,
"floating %s%s at %"IVdf"..%"UVuf" ",
s, RE_SV_TAIL(r->float_substr),
(IV)r->float_min_offset, (UV)r->float_max_offset);
} else if (r->float_utf8) {
- RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->float_utf8),
+ RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->float_utf8),
RE_SV_DUMPLEN(r->float_utf8), 30);
PerlIO_printf(Perl_debug_log,
"floating utf8 %s%s at %"IVdf"..%"UVuf" ",
(r->check_substr == r->float_substr
&& r->check_utf8 == r->float_utf8
? "(checking floating" : "(checking anchored"));
- if (r->extflags & RXf_NOSCAN)
+ if (r->intflags & PREGf_NOSCAN)
PerlIO_printf(Perl_debug_log, " noscan");
if (r->extflags & RXf_CHECK_ALL)
PerlIO_printf(Perl_debug_log, " isall");
regprop(r, sv, ri->regstclass);
PerlIO_printf(Perl_debug_log, "stclass %s ", SvPVX_const(sv));
}
- if (r->extflags & RXf_ANCH) {
+ if (r->intflags & PREGf_ANCH) {
PerlIO_printf(Perl_debug_log, "anchored");
- if (r->extflags & RXf_ANCH_BOL)
+ if (r->intflags & PREGf_ANCH_BOL)
PerlIO_printf(Perl_debug_log, "(BOL)");
- if (r->extflags & RXf_ANCH_MBOL)
+ if (r->intflags & PREGf_ANCH_MBOL)
PerlIO_printf(Perl_debug_log, "(MBOL)");
- if (r->extflags & RXf_ANCH_SBOL)
+ if (r->intflags & PREGf_ANCH_SBOL)
PerlIO_printf(Perl_debug_log, "(SBOL)");
- if (r->extflags & RXf_ANCH_GPOS)
+ if (r->intflags & PREGf_ANCH_GPOS)
PerlIO_printf(Perl_debug_log, "(GPOS)");
PerlIO_putc(Perl_debug_log, ' ');
}
- if (r->extflags & RXf_GPOS_SEEN)
+ if (r->intflags & PREGf_GPOS_SEEN)
PerlIO_printf(Perl_debug_log, "GPOS:%"UVuf" ", (UV)r->gofs);
if (r->intflags & PREGf_SKIP)
PerlIO_printf(Perl_debug_log, "plus ");
/*
- regprop - printable representation of opcode
*/
-#define EMIT_ANYOF_TEST_SEPARATOR(do_sep,sv,flags) \
-STMT_START { \
- if (do_sep) { \
- Perl_sv_catpvf(aTHX_ sv,"%s][%s",PL_colors[1],PL_colors[0]); \
- if (flags & ANYOF_INVERT) \
- /*make sure the invert info is in each */ \
- sv_catpvs(sv, "^"); \
- do_sep = 0; \
- } \
-} STMT_END
void
Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
|| _CC_VERTSPACE != 16
#error Need to adjust order of anyofs[]
#endif
- "[\\w]",
- "[\\W]",
- "[\\d]",
- "[\\D]",
+ "\\w",
+ "\\W",
+ "\\d",
+ "\\D",
"[:alpha:]",
"[:^alpha:]",
"[:lower:]",
"[:^graph:]",
"[:cased:]",
"[:^cased:]",
- "[\\s]",
- "[\\S]",
+ "\\s",
+ "\\S",
"[:blank:]",
"[:^blank:]",
"[:xdigit:]",
"[:^cntrl:]",
"[:ascii:]",
"[:^ascii:]",
- "[\\v]",
- "[\\V]"
+ "\\v",
+ "\\V"
};
RXi_GET_DECL(prog,progi);
GET_RE_DEBUG_FLAGS_DECL;
-
+
PERL_ARGS_ASSERT_REGPROP;
sv_setpvs(sv, "");
if (OP(o) > REGNODE_MAX) /* regnode.type is unsigned */
/* It would be nice to FAIL() here, but this may be called from
regexec.c, and it would be hard to supply pRExC_state. */
- Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", (int)OP(o), (int)REGNODE_MAX);
+ Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d",
+ (int)OP(o), (int)REGNODE_MAX);
sv_catpv(sv, PL_reg_name[OP(o)]); /* Take off const! */
k = PL_regkind[OP(o)];
if (k == EXACT) {
sv_catpvs(sv, " ");
- /* Using is_utf8_string() (via PERL_PV_UNI_DETECT)
- * is a crude hack but it may be the best for now since
- * we have no flag "this EXACTish node was UTF-8"
+ /* Using is_utf8_string() (via PERL_PV_UNI_DETECT)
+ * is a crude hack but it may be the best for now since
+ * we have no flag "this EXACTish node was UTF-8"
* --jhi */
pv_pretty(sv, STRING(o), STR_LEN(o), 60, PL_colors[0], PL_colors[1],
PERL_PV_ESCAPE_UNI_DETECT |
NULL;
const reg_trie_data * const trie
= (reg_trie_data*)progi->data->data[!IS_TRIE_AC(op) ? n : ac->trie];
-
+
Perl_sv_catpvf(aTHX_ sv, "-%s",PL_reg_name[o->flags]);
DEBUG_TRIE_COMPILE_r(
- Perl_sv_catpvf(aTHX_ sv,
- "<S:%"UVuf"/%"IVdf" W:%"UVuf" L:%"UVuf"/%"UVuf" C:%"UVuf"/%"UVuf">",
- (UV)trie->startstate,
- (IV)trie->statecount-1, /* -1 because of the unused 0 element */
- (UV)trie->wordcount,
- (UV)trie->minlen,
- (UV)trie->maxlen,
- (UV)TRIE_CHARCOUNT(trie),
- (UV)trie->uniquecharcount
- )
+ Perl_sv_catpvf(aTHX_ sv,
+ "<S:%"UVuf"/%"IVdf" W:%"UVuf" L:%"UVuf"/%"UVuf" C:%"UVuf"/%"UVuf">",
+ (UV)trie->startstate,
+ (IV)trie->statecount-1, /* -1 because of the unused 0 element */
+ (UV)trie->wordcount,
+ (UV)trie->minlen,
+ (UV)trie->maxlen,
+ (UV)TRIE_CHARCOUNT(trie),
+ (UV)trie->uniquecharcount
+ )
);
if ( IS_ANYOF_TRIE(op) || trie->bitmap ) {
sv_catpvs(sv, "[");
? ANYOF_BITMAP(o)
: TRIE_BITMAP(trie));
sv_catpvs(sv, "]");
- }
-
+ }
+
} else if (k == CURLY) {
if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX)
Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */
}
else if (k == WHILEM && o->flags) /* Ordinal/of */
Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4);
- else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP || OP(o)==ACCEPT) {
+ else if (k == REF || k == OPEN || k == CLOSE
+ || k == GROUPP || OP(o)==ACCEPT)
+ {
Perl_sv_catpvf(aTHX_ sv, "%d", (int)ARG(o)); /* Parenth number */
if ( RXp_PAREN_NAMES(prog) ) {
if ( k != REF || (OP(o) < NREF)) {
SV **name= av_fetch(list, ARG(o), 0 );
if (name)
Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name));
- }
+ }
else {
AV *list= MUTABLE_AV(progi->data->data[ progi->name_list_idx ]);
SV *sv_dat= MUTABLE_SV(progi->data->data[ ARG( o ) ]);
Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name));
}
}
- }
- } else if (k == GOSUB)
- Perl_sv_catpvf(aTHX_ sv, "%d[%+d]", (int)ARG(o),(int)ARG2L(o)); /* Paren and offset */
+ }
+ } else if (k == GOSUB)
+ /* Paren and offset */
+ Perl_sv_catpvf(aTHX_ sv, "%d[%+d]", (int)ARG(o),(int)ARG2L(o));
else if (k == VERB) {
- if (!o->flags)
- Perl_sv_catpvf(aTHX_ sv, ":%"SVf,
+ if (!o->flags)
+ Perl_sv_catpvf(aTHX_ sv, ":%"SVf,
SVfARG((MUTABLE_SV(progi->data->data[ ARG( o ) ]))));
} else if (k == LOGICAL)
- Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */
+ /* 2: embedded, otherwise 1 */
+ Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags);
else if (k == ANYOF) {
const U8 flags = ANYOF_FLAGS(o);
int do_sep = 0;
/* output what the standard cp 0-255 bitmap matches */
do_sep = put_latin1_charclass_innards(sv, ANYOF_BITMAP(o));
-
- EMIT_ANYOF_TEST_SEPARATOR(do_sep,sv,flags);
- /* output any special charclass tests (used entirely under use locale) */
+
+ /* output any special charclass tests (used entirely under use
+ * locale) * */
if (ANYOF_POSIXL_TEST_ANY_SET(o)) {
int i;
for (i = 0; i < ANYOF_POSIXL_MAX; i++) {
}
}
}
-
- EMIT_ANYOF_TEST_SEPARATOR(do_sep,sv,flags);
-
- if (flags & ANYOF_NON_UTF8_LATIN1_ALL) {
- sv_catpvs(sv, "{non-utf8-latin1-all}");
- }
-
- /* output information about the unicode matching */
- if (flags & ANYOF_ABOVE_LATIN1_ALL)
- sv_catpvs(sv, "{unicode_all}");
- else if (ANYOF_NONBITMAP(o)) {
- SV *lv; /* Set if there is something outside the bit map. */
- bool byte_output = FALSE; /* If something in the bitmap has been
- output */
- if (flags & ANYOF_NONBITMAP_NON_UTF8) {
- sv_catpvs(sv, "{outside bitmap}");
+ if ((flags & ANYOF_ABOVE_LATIN1_ALL)
+ || ANYOF_UTF8_LOCALE_INVLIST(o) || ANYOF_NONBITMAP(o))
+ {
+ if (do_sep) {
+ Perl_sv_catpvf(aTHX_ sv,"%s][%s",PL_colors[1],PL_colors[0]);
+ if (flags & ANYOF_INVERT)
+ /*make sure the invert info is in each */
+ sv_catpvs(sv, "^");
}
- else {
- sv_catpvs(sv, "{utf8}");
+
+ if (flags & ANYOF_NON_UTF8_NON_ASCII_ALL) {
+ sv_catpvs(sv, "{non-utf8-latin1-all}");
}
- /* Get the stuff that wasn't in the bitmap */
- (void) regclass_swash(prog, o, FALSE, &lv, NULL);
- if (lv && lv != &PL_sv_undef) {
- char *s = savesvpv(lv);
- char * const origs = s;
+ /* output information about the unicode matching */
+ if (flags & ANYOF_ABOVE_LATIN1_ALL)
+ sv_catpvs(sv, "{unicode_all}");
+ else if (ANYOF_NONBITMAP(o)) {
+ SV *lv; /* Set if there is something outside the bit map. */
+ bool byte_output = FALSE; /* If something in the bitmap has
+ been output */
+
+ /* Get the stuff that wasn't in the bitmap */
+ (void) regclass_swash(prog, o, FALSE, &lv, NULL);
+ if (lv && lv != &PL_sv_undef) {
+ char *s = savesvpv(lv);
+ char * const origs = s;
+
+ while (*s && *s != '\n')
+ s++;
- while (*s && *s != '\n')
- s++;
+ if (*s == '\n') {
+ const char * const t = ++s;
- if (*s == '\n') {
- const char * const t = ++s;
+ if (flags & ANYOF_NONBITMAP_NON_UTF8) {
+ sv_catpvs(sv, "{outside bitmap}");
+ }
+ else {
+ sv_catpvs(sv, "{utf8}");
+ }
- if (byte_output) {
- sv_catpvs(sv, " ");
- }
+ if (byte_output) {
+ sv_catpvs(sv, " ");
+ }
- while (*s) {
- if (*s == '\n') {
+ while (*s) {
+ if (*s == '\n') {
- /* Truncate very long output */
- if (s - origs > 256) {
- Perl_sv_catpvf(aTHX_ sv,
- "%.*s...",
- (int) (s - origs - 1),
- t);
- goto out_dump;
+ /* Truncate very long output */
+ if (s - origs > 256) {
+ Perl_sv_catpvf(aTHX_ sv,
+ "%.*s...",
+ (int) (s - origs - 1),
+ t);
+ goto out_dump;
+ }
+ *s = ' ';
}
- *s = ' ';
- }
- else if (*s == '\t') {
- *s = '-';
+ else if (*s == '\t') {
+ *s = '-';
+ }
+ s++;
}
- s++;
+ if (s[-1] == ' ')
+ s[-1] = 0;
+
+ sv_catpv(sv, t);
}
- if (s[-1] == ' ')
- s[-1] = 0;
- sv_catpv(sv, t);
- }
+ out_dump:
- out_dump:
+ Safefree(origs);
+ SvREFCNT_dec_NN(lv);
+ }
+ }
- Safefree(origs);
- SvREFCNT_dec_NN(lv);
- }
+ /* Output any UTF-8 locale code points */
+ if (flags & ANYOF_LOC_FOLD && ANYOF_UTF8_LOCALE_INVLIST(o)) {
+ UV start, end;
+ int max_entries = 256;
+
+ sv_catpvs(sv, "{utf8 locale}");
+ invlist_iterinit(ANYOF_UTF8_LOCALE_INVLIST(o));
+ while (invlist_iternext(ANYOF_UTF8_LOCALE_INVLIST(o),
+ &start, &end)) {
+ put_range(sv, start, end);
+ max_entries --;
+ if (max_entries < 0) {
+ sv_catpvs(sv, "...");
+ break;
+ }
+ }
+ invlist_iterfinish(ANYOF_UTF8_LOCALE_INVLIST(o));
+ }
}
Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
Perl_sv_catpvf(aTHX_ sv, "[illegal type=%d])", index);
}
else {
+ if (*anyofs[index] != '[') {
+ sv_catpv(sv, "[");
+ }
sv_catpv(sv, anyofs[index]);
+ if (*anyofs[index] != '[') {
+ sv_catpv(sv, "]");
+ }
}
}
else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH))
return prog->check_substr ? prog->check_substr : prog->check_utf8;
}
-/*
- pregfree()
-
- handles refcounting and freeing the perl core regexp structure. When
- it is necessary to actually free the structure the first thing it
+/*
+ pregfree()
+
+ handles refcounting and freeing the perl core regexp structure. When
+ it is necessary to actually free the structure the first thing it
does is call the 'free' method of the regexp_engine associated to
- the regexp, allowing the handling of the void *pprivate; member
- first. (This routine is not overridable by extensions, which is why
+ the regexp, allowing the handling of the void *pprivate; member
+ first. (This routine is not overridable by extensions, which is why
the extensions free is called first.)
-
- See regdupe and regdupe_internal if you change anything here.
+
+ See regdupe and regdupe_internal if you change anything here.
*/
#ifndef PERL_IN_XSUB_RE
void
CALLREGFREE_PVT(rx); /* free the private data */
SvREFCNT_dec(RXp_PAREN_NAMES(r));
Safefree(r->xpv_len_u.xpvlenu_pv);
- }
+ }
if (r->substrs) {
SvREFCNT_dec(r->anchored_substr);
SvREFCNT_dec(r->anchored_utf8);
}
/* reg_temp_copy()
-
+
This is a hacky workaround to the structural issue of match results
being stored in the regexp structure which is in turn stored in
PL_curpm/PL_reg_curpm. The problem is that due to qr// the pattern
could be PL_curpm in multiple contexts, and could require multiple
result sets being associated with the pattern simultaneously, such
as when doing a recursive match with (??{$qr})
-
- The solution is to make a lightweight copy of the regexp structure
+
+ The solution is to make a lightweight copy of the regexp structure
when a qr// is returned from the code executed by (??{$qr}) this
lightweight copy doesn't actually own any of its data except for
- the starp/end and the actual regexp structure itself.
-
-*/
-
-
+ the starp/end and the actual regexp structure itself.
+
+*/
+
+
REGEXP *
Perl_reg_temp_copy (pTHX_ REGEXP *ret_x, REGEXP *rx)
{
sv_force_normal(sv) is called. */
SvFAKE_on(ret_x);
ret = ReANY(ret_x);
-
+
SvFLAGS(ret_x) |= SvUTF8(rx);
/* We share the same string buffer as the original regexp, on which we
hold a reference count, incremented when mother_re is set below.
#endif
ret->mother_re = ReREFCNT_inc(r->mother_re ? r->mother_re : rx);
SvREFCNT_inc_void(ret->qr_anoncv);
-
+
return ret_x;
}
#endif
-/* regfree_internal()
+/* regfree_internal()
+
+ Free the private data in a regexp. This is overloadable by
+ extensions. Perl takes care of the regexp structure in pregfree(),
+ this covers the *pprivate pointer which technically perl doesn't
+ know about, however of course we have to handle the
+ regexp_internal structure when no extension is in use.
- Free the private data in a regexp. This is overloadable by
- extensions. Perl takes care of the regexp structure in pregfree(),
- this covers the *pprivate pointer which technically perl doesn't
- know about, however of course we have to handle the
- regexp_internal structure when no extension is in use.
-
- Note this is called before freeing anything in the regexp
- structure.
+ Note this is called before freeing anything in the regexp
+ structure.
*/
-
+
void
Perl_regfree_internal(pTHX_ REGEXP * const rx)
{
SV *dsv= sv_newmortal();
RE_PV_QUOTED_DECL(s, RX_UTF8(rx),
dsv, RX_PRECOMP(rx), RX_PRELEN(rx), 60);
- PerlIO_printf(Perl_debug_log,"%sFreeing REx:%s %s\n",
+ PerlIO_printf(Perl_debug_log,"%sFreeing REx:%s %s\n",
PL_colors[4],PL_colors[5],s);
}
});
case 'l':
case 'L':
break;
- case 'T':
+ case 'T':
{ /* Aho Corasick add-on structure for a trie node.
Used in stclass optimization only */
U32 refcount;
}
break;
default:
- Perl_croak(aTHX_ "panic: regfree data code '%c'", ri->data->what[n]);
+ Perl_croak(aTHX_ "panic: regfree data code '%c'",
+ ri->data->what[n]);
}
}
Safefree(ri->data->what);
#define hv_dup_inc(s,t) MUTABLE_HV(sv_dup_inc((const SV *)s,t))
#define SAVEPVN(p,n) ((p) ? savepvn(p,n) : NULL)
-/*
- re_dup - duplicate a regexp.
-
+/*
+ re_dup - duplicate a regexp.
+
This routine is expected to clone a given regexp structure. It is only
compiled under USE_ITHREADS.
stored in the *pprivate pointer. This allows extensions to handle
any duplication it needs to do.
- See pregfree() and regfree_internal() if you change anything here.
+ See pregfree() and regfree_internal() if you change anything here.
*/
#if defined(USE_ITHREADS)
#ifndef PERL_IN_XSUB_RE
I32 npar;
const struct regexp *r = ReANY(sstr);
struct regexp *ret = ReANY(dstr);
-
+
PERL_ARGS_ASSERT_RE_DUP_GUTS;
npar = r->nparens+1;
/*
regdupe_internal()
-
+
This is the internal complement to regdupe() which is used to copy
the structure pointed to by the *pprivate pointer in the regexp.
This is the core version of the extension overridable cloning hook.
The regexp structure being duplicated will be copied by perl prior
- to this and will be provided as the regexp *r argument, however
+ to this and will be provided as the regexp *r argument, however
with the /old/ structures pprivate pointer value. Thus this routine
may override any copying normally done by perl.
-
+
It returns a pointer to the new regexp_internal structure.
*/
RXi_GET_DECL(r,ri);
PERL_ARGS_ASSERT_REGDUPE_INTERNAL;
-
+
len = ProgLen(ri);
-
- Newxc(reti, sizeof(regexp_internal) + len*sizeof(regnode), char, regexp_internal);
+
+ Newxc(reti, sizeof(regexp_internal) + len*sizeof(regnode),
+ char, regexp_internal);
Copy(ri->program, reti->program, len+1, regnode);
reti->num_code_blocks = ri->num_code_blocks;
d->data[i] = ri->data->data[i];
break;
default:
- Perl_croak(aTHX_ "panic: re_dup unknown data code '%c'", ri->data->what[i]);
+ Perl_croak(aTHX_ "panic: re_dup unknown data code '%c'",
+ ri->data->what[i]);
}
}
return(NULL);
if (OP(p) > REGNODE_MAX) { /* regnode.type is unsigned */
- Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", (int)OP(p), (int)REGNODE_MAX);
+ Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d",
+ (int)OP(p), (int)REGNODE_MAX);
}
offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p));
U32 i;
for (i = 1; i <= RX_NPARENS(rx); i++) {
char digits[TYPE_CHARS(long)];
- const STRLEN len = my_snprintf(digits, sizeof(digits), "%lu", (long)i);
+ const STRLEN len = my_snprintf(digits, sizeof(digits),
+ "%lu", (long)i);
GV *const *const gvp
= (GV**)hv_fetch(PL_defstash, digits, len, 0);
{
PERL_ARGS_ASSERT_PUT_BYTE;
- /* Our definition of isPRINT() ignores locales, so only bytes that are
- not part of UTF-8 are considered printable. I assume that the same
- holds for UTF-EBCDIC.
- Also, code point 255 is not printable in either (it's E0 in EBCDIC,
- which Wikipedia says:
-
- EO, or Eight Ones, is an 8-bit EBCDIC character code represented as all
- ones (binary 1111 1111, hexadecimal FF). It is similar, but not
- identical, to the ASCII delete (DEL) or rubout control character. ...
- it is typically mapped to hexadecimal code 9F, in order to provide a
- unique character mapping in both directions)
-
- So the old condition can be simplified to !isPRINT(c) */
if (!isPRINT(c)) {
switch (c) {
case '\r': Perl_sv_catpvf(aTHX_ sv, "\\r"); break;
}
}
+STATIC void
+S_put_range(pTHX_ SV *sv, UV start, UV end)
+{
+
+ /* Appends to 'sv' a displayable version of the range of code points from
+ * 'start' to 'end' */
+
+ assert(start <= end);
+
+ PERL_ARGS_ASSERT_PUT_RANGE;
+
+ if (end - start < 3) { /* Individual chars in short ranges */
+ for (; start <= end; start++)
+ put_byte(sv, start);
+ }
+ else if ( end > 255
+ || ! isALPHANUMERIC(start)
+ || ! isALPHANUMERIC(end)
+ || isDIGIT(start) != isDIGIT(end)
+ || isUPPER(start) != isUPPER(end)
+ || isLOWER(start) != isLOWER(end)
+
+ /* This final test should get optimized out except on EBCDIC
+ * platforms, where it causes ranges that cross discontinuities
+ * like i/j to be shown as hex instead of the misleading,
+ * e.g. H-K (since that range includes more than H, I, J, K).
+ * */
+ || (end - start) != NATIVE_TO_ASCII(end) - NATIVE_TO_ASCII(start))
+ {
+ Perl_sv_catpvf(aTHX_ sv, "\\x{%02" UVXf "}-\\x{%02" UVXf "}",
+ start,
+ (end < 256) ? end : 255);
+ }
+ else { /* Here, the ends of the range are both digits, or both uppercase,
+ or both lowercase; and there's no discontinuity in the range
+ (which could happen on EBCDIC platforms) */
+ put_byte(sv, start);
+ sv_catpvs(sv, "-");
+ put_byte(sv, end);
+ }
+}
+
STATIC bool
S_put_latin1_charclass_innards(pTHX_ SV *sv, char *bitmap)
{
* output anything */
int i;
- int rangestart = -1;
bool has_output_anything = FALSE;
PERL_ARGS_ASSERT_PUT_LATIN1_CHARCLASS_INNARDS;
- for (i = 0; i <= 256; i++) {
+ for (i = 0; i < 256; i++) {
if (i < 256 && BITMAP_TEST((U8 *) bitmap,i)) {
- if (rangestart == -1)
- rangestart = i;
- } else if (rangestart != -1) {
- int j = i - 1;
- if (i <= rangestart + 3) { /* Individual chars in short ranges */
- for (; rangestart < i; rangestart++)
- put_byte(sv, rangestart);
- }
- else if ( j > 255
- || ! isALPHANUMERIC(rangestart)
- || ! isALPHANUMERIC(j)
- || isDIGIT(rangestart) != isDIGIT(j)
- || isUPPER(rangestart) != isUPPER(j)
- || isLOWER(rangestart) != isLOWER(j)
-
- /* This final test should get optimized out except
- * on EBCDIC platforms, where it causes ranges that
- * cross discontinuities like i/j to be shown as hex
- * instead of the misleading, e.g. H-K (since that
- * range includes more than H, I, J, K). */
- || (j - rangestart)
- != NATIVE_TO_ASCII(j) - NATIVE_TO_ASCII(rangestart))
- {
- Perl_sv_catpvf(aTHX_ sv, "\\x{%02x}-\\x{%02x}",
- rangestart,
- (j < 256) ? j : 255);
- }
- else { /* Here, the ends of the range are both digits, or both
- uppercase, or both lowercase; and there's no
- discontinuity in the range (which could happen on EBCDIC
- platforms) */
- put_byte(sv, rangestart);
- sv_catpvs(sv, "-");
- put_byte(sv, j);
- }
- rangestart = -1;
+
+ /* The character at index i should be output. Find the next
+ * character that should NOT be output */
+ int j;
+ for (j = i + 1; j <= 256; j++) {
+ if (! BITMAP_TEST((U8 *) bitmap, j)) {
+ break;
+ }
+ }
+
+ /* Everything between them is a single range that should be output
+ * */
+ put_range(sv, i, j - 1);
has_output_anything = TRUE;
+ i = j;
}
}
}
#define CLEAR_OPTSTART \
- if (optstart) STMT_START { \
- DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log, " (%"IVdf" nodes)\n", (IV)(node - optstart))); \
- optstart=NULL; \
+ if (optstart) STMT_START { \
+ DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log, \
+ " (%"IVdf" nodes)\n", (IV)(node - optstart))); \
+ optstart=NULL; \
} STMT_END
-#define DUMPUNTIL(b,e) CLEAR_OPTSTART; node=dumpuntil(r,start,(b),(e),last,sv,indent+1,depth+1);
+#define DUMPUNTIL(b,e) \
+ CLEAR_OPTSTART; \
+ node=dumpuntil(r,start,(b),(e),last,sv,indent+1,depth+1);
STATIC const regnode *
S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
- const regnode *last, const regnode *plast,
+ const regnode *last, const regnode *plast,
SV* sv, I32 indent, U32 depth)
{
dVAR;
U8 op = PSEUDO; /* Arbitrary non-END op. */
const regnode *next;
const regnode *optstart= NULL;
-
+
RXi_GET_DECL(r,ri);
GET_RE_DEBUG_FLAGS_DECL;
PerlIO_printf(Perl_debug_log, "--- %d : %d - %d - %d\n",indent,node-start,
last ? last-start : 0,plast ? plast-start : 0);
#endif
-
- if (plast && plast < last)
+
+ if (plast && plast < last)
last= plast;
while (PL_regkind[op] != END && (!last || node < last)) {
regprop(r, sv, node);
PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start),
(int)(2*indent + 1), "", SvPVX_const(sv));
-
- if (OP(node) != OPTIMIZED) {
+
+ if (OP(node) != OPTIMIZED) {
if (next == NULL) /* Next ptr. */
PerlIO_printf(Perl_debug_log, " (0)");
- else if (PL_regkind[(U8)op] == BRANCH && PL_regkind[OP(next)] != BRANCH )
+ else if (PL_regkind[(U8)op] == BRANCH
+ && PL_regkind[OP(next)] != BRANCH )
PerlIO_printf(Perl_debug_log, " (FAIL)");
- else
+ else
PerlIO_printf(Perl_debug_log, " (%"IVdf")", (IV)(next - start));
- (void)PerlIO_putc(Perl_debug_log, '\n');
+ (void)PerlIO_putc(Perl_debug_log, '\n');
}
-
+
after_print:
if (PL_regkind[(U8)op] == BRANCHJ) {
assert(next);
const reg_trie_data * const trie =
(reg_trie_data*)ri->data->data[op<AHOCORASICK ? n : ac->trie];
#ifdef DEBUGGING
- AV *const trie_words = MUTABLE_AV(ri->data->data[n + TRIE_WORDS_OFFSET]);
+ AV *const trie_words
+ = MUTABLE_AV(ri->data->data[n + TRIE_WORDS_OFFSET]);
#endif
const regnode *nextbranch= NULL;
I32 word_idx;
PerlIO_printf(Perl_debug_log, "%*s%s ",
(int)(2*(indent+3)), "",
- 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_ELLIPSES |
- PERL_PV_PRETTY_LTGT
+ 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_ELLIPSES
+ | PERL_PV_PRETTY_LTGT
)
- : "???"
+ : "???"
);
if (trie->jump) {
U16 dist= trie->jump[word_idx+1];
PerlIO_printf(Perl_debug_log, "(%"UVuf")\n",
- (UV)((dist ? this_trie + dist : next) - start));
+ (UV)((dist ? this_trie + dist : next) - start));
if (dist) {
if (!nextbranch)
- nextbranch= this_trie + trie->jump[0];
+ nextbranch= this_trie + trie->jump[0];
DUMPUNTIL(this_trie + dist, nextbranch);
}
if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
}
else if (PL_regkind[(U8)op] == ANYOF) {
/* arglen 1 + class block */
- node += 1 + ((ANYOF_FLAGS(node) & ANYOF_POSIXL)
- ? ANYOF_POSIXL_SKIP : ANYOF_SKIP);
+ node += 1 + ((ANYOF_FLAGS(node) & ANYOF_LOC_FOLD)
+ ? ANYOF_POSIXL_FOLD_SKIP
+ : (ANYOF_FLAGS(node) & ANYOF_POSIXL)
+ ? ANYOF_POSIXL_SKIP
+ : ANYOF_SKIP);
node = NEXTOPER(node);
}
else if (PL_regkind[(U8)op] == EXACT) {
indent++;
}
CLEAR_OPTSTART;
-#ifdef DEBUG_DUMPUNTIL
+#ifdef DEBUG_DUMPUNTIL
PerlIO_printf(Perl_debug_log, "--- %d\n", (int)indent);
#endif
return node;
https://perl5.git.perl.org / perl5.git / blobdiff