*/
/* The names of the functions have been changed from regcomp and
- * regexec to pregcomp and pregexec in order to avoid conflicts
+ * regexec to pregcomp and pregexec in order to avoid conflicts
* with the POSIX routines of the same names.
*/
I32 orig_utf8; /* whether the pattern was originally in utf8 */
/* XXX use this for future optimisation of case
* where pattern must be upgraded to utf8. */
+ I32 uni_semantics; /* If a d charset modifier should use unicode
+ 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 */
+ I32 in_lookbehind;
#if ADD_TO_REGEXEC
char *starttry; /* -Dr: where regtry was called. */
#define RExC_starttry (pRExC_state->starttry)
#define RExC_seen_zerolen (pRExC_state->seen_zerolen)
#define RExC_seen_evals (pRExC_state->seen_evals)
#define RExC_utf8 (pRExC_state->utf8)
+#define RExC_uni_semantics (pRExC_state->uni_semantics)
#define RExC_orig_utf8 (pRExC_state->orig_utf8)
#define RExC_open_parens (pRExC_state->open_parens)
#define RExC_close_parens (pRExC_state->close_parens)
#define RExC_paren_names (pRExC_state->paren_names)
#define RExC_recurse (pRExC_state->recurse)
#define RExC_recurse_count (pRExC_state->recurse_count)
+#define RExC_in_lookbehind (pRExC_state->in_lookbehind)
#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
#define HASWIDTH 0x01 /* Known to match non-null strings. */
/* Simple enough to be STAR/PLUS operand, in an EXACT node must be a single
- * character, and if utf8, must be invariant. */
+ * character, and if utf8, must be invariant. Note that this is not the same thing as REGNODE_SIMPLE */
#define SIMPLE 0x02
#define SPSTART 0x04 /* Starts with * or +. */
#define TRYAGAIN 0x08 /* Weeded out a declaration. */
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
- string that must appear for at a fixed location, and we look for the
+ 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:
- 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
- character must match before the string we are searching.
- Likewise when combined with minlenp and the length of the string
+ 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
found.
- max_offset
Only used for floating strings. This is the rightmost point that
- the string can appear at. Ifset to I32 max it indicates that the
+ the string can appear at. If set to I32 max it indicates that the
string can occur infinitely far to the right.
- minlenp
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
looked for. Since strings can be composites this is the length of the
- pattern at the time it was commited with a scan_commit. Note that
+ 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
pointer to the value.
SV **longest; /* Either &l_fixed, or &l_float. */
SV *longest_fixed; /* longest fixed string found in pattern */
I32 offset_fixed; /* offset where it starts */
- I32 *minlen_fixed; /* pointer to the minlen relevent to the string */
+ I32 *minlen_fixed; /* pointer to the minlen relevant to the string */
I32 lookbehind_fixed; /* is the position of the string modfied by LB */
SV *longest_float; /* longest floating string found in pattern */
I32 offset_float_min; /* earliest point in string it can appear */
I32 offset_float_max; /* latest point in string it can appear */
- I32 *minlen_float; /* pointer to the minlen relevent to the string */
+ I32 *minlen_float; /* pointer to the minlen relevant to the string */
I32 lookbehind_float; /* is the position of the string modified by LB */
I32 flags;
I32 whilem_c;
#define SCF_SEEN_ACCEPT 0x8000
#define UTF cBOOL(RExC_utf8)
-#define LOC cBOOL(RExC_flags & RXf_PMf_LOCALE)
-#define UNI_SEMANTICS cBOOL(RExC_flags & RXf_PMf_UNICODE)
+#define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET)
+#define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET)
+#define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_DEPENDS_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 FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
#define OOB_UNICODE 12345678
#if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
#define EXPERIMENTAL_INPLACESCAN
-#endif /*RE_TRACK_PATTERN_OFFSETS*/
+#endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
#define DEBUG_STUDYDATA(str,data,depth) \
DEBUG_OPTIMISE_MORE_r(if(data){ \
ANYOF_CLASS_ZERO(cl);
ANYOF_BITMAP_SETALL(cl);
- cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL;
+ cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL|ANYOF_LOC_NONBITMAP_FOLD|ANYOF_NON_UTF8_LATIN1_ALL;
if (LOC)
cl->flags |= ANYOF_LOCALE;
}
PERL_ARGS_ASSERT_CL_AND;
assert(and_with->type == ANYOF);
- if (!(and_with->flags & ANYOF_CLASS)
- && !(cl->flags & ANYOF_CLASS)
+
+ if (!(ANYOF_CLASS_TEST_ANY_SET(and_with))
+ && !(ANYOF_CLASS_TEST_ANY_SET(cl))
&& (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
- && !(and_with->flags & ANYOF_FOLD)
- && !(cl->flags & ANYOF_FOLD)) {
+ && !(and_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
+ && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) {
int i;
if (and_with->flags & ANYOF_INVERT)
if (!(and_with->flags & ANYOF_EOS))
cl->flags &= ~ANYOF_EOS;
- if (cl->flags & ANYOF_UNICODE_ALL && and_with->flags & ANYOF_UNICODE &&
- !(and_with->flags & ANYOF_INVERT)) {
- cl->flags &= ~ANYOF_UNICODE_ALL;
- cl->flags |= ANYOF_UNICODE;
+ if (!(and_with->flags & ANYOF_LOC_NONBITMAP_FOLD))
+ cl->flags &= ~ANYOF_LOC_NONBITMAP_FOLD;
+ if (!(and_with->flags & ANYOF_NON_UTF8_LATIN1_ALL))
+ cl->flags &= ~ANYOF_NON_UTF8_LATIN1_ALL;
+
+ if (cl->flags & ANYOF_UNICODE_ALL
+ && and_with->flags & ANYOF_NONBITMAP
+ && !(and_with->flags & ANYOF_INVERT))
+ {
+ if (! (and_with->flags & ANYOF_UNICODE_ALL)) {
+ cl->flags &= ~ANYOF_UNICODE_ALL;
+ }
+ cl->flags |= and_with->flags & ANYOF_NONBITMAP; /* field is 2 bits; use
+ only the one(s)
+ actually set */
ARG_SET(cl, ARG(and_with));
}
if (!(and_with->flags & ANYOF_UNICODE_ALL) &&
!(and_with->flags & ANYOF_INVERT))
cl->flags &= ~ANYOF_UNICODE_ALL;
- if (!(and_with->flags & (ANYOF_UNICODE|ANYOF_UNICODE_ALL)) &&
+ if (!(and_with->flags & (ANYOF_NONBITMAP|ANYOF_UNICODE_ALL)) &&
!(and_with->flags & ANYOF_INVERT))
- cl->flags &= ~ANYOF_UNICODE;
+ cl->flags &= ~ANYOF_NONBITMAP;
}
/* 'OR' a given class with another one. Can create false positives */
* (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
*/
if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
- && !(or_with->flags & ANYOF_FOLD)
- && !(cl->flags & ANYOF_FOLD) ) {
+ && !(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
+ && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD) ) {
int i;
for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
} else {
/* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
- && (!(or_with->flags & ANYOF_FOLD)
- || (cl->flags & ANYOF_FOLD)) ) {
+ && (!(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
+ || (cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) ) {
int i;
/* OR char bitmap and class bitmap separately */
for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
cl->bitmap[i] |= or_with->bitmap[i];
- if (or_with->flags & ANYOF_CLASS) {
+ if (ANYOF_CLASS_TEST_ANY_SET(or_with)) {
for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
cl->classflags[i] |= or_with->classflags[i];
cl->flags |= ANYOF_CLASS;
}
if (or_with->flags & ANYOF_EOS)
cl->flags |= ANYOF_EOS;
+ if (!(or_with->flags & ANYOF_NON_UTF8_LATIN1_ALL))
+ cl->flags |= ANYOF_NON_UTF8_LATIN1_ALL;
- if (cl->flags & ANYOF_UNICODE && or_with->flags & ANYOF_UNICODE &&
+ if (or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
+ cl->flags |= ANYOF_LOC_NONBITMAP_FOLD;
+
+ /* If both nodes match something outside the bitmap, but what they match
+ * outside is not the same pointer, and hence not easily compared, give up
+ * and allow the start class to match everything outside the bitmap */
+ if (cl->flags & ANYOF_NONBITMAP && or_with->flags & ANYOF_NONBITMAP &&
ARG(cl) != ARG(or_with)) {
cl->flags |= ANYOF_UNICODE_ALL;
- cl->flags &= ~ANYOF_UNICODE;
}
+
if (or_with->flags & ANYOF_UNICODE_ALL) {
cl->flags |= ANYOF_UNICODE_ALL;
- cl->flags &= ~ANYOF_UNICODE;
}
}
tables that are used to generate the final compressed
representation which is what dump_trie expects.
- Part of the reason for their existance is to provide a form
+ Part of the reason for their existence is to provide a form
of documentation as to how the different representations function.
*/
Dumps the final compressed table form of the trie to Perl_debug_log.
Used for debugging make_trie().
*/
-
+
STATIC void
S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap,
AV *revcharmap, U32 depth)
/ (DUPE|DUPE) X? (?{ ... }) Y /x
-Thus EVAL blocks follwing a trie may be called a different number of times with
+Thus EVAL blocks following a trie may be called a different number of times with
and without the optimisation. With the optimisations dupes will be silently
-ignored. This inconsistant behaviour of EVAL type nodes is well established as
+ignored. This inconsistent behaviour of EVAL type nodes is well established as
the following demonstrates:
'words'=~/(word|word|word)(?{ print $1 })[xyz]/
Example of what happens on a structural level:
-The regexp /(ac|ad|ab)+/ will produce the folowing debug output:
+The regexp /(ac|ad|ab)+/ will produce the following debug output:
1: CURLYM[1] {1,32767}(18)
5: BRANCH(8)
regnode *convert = NULL;
U32 *prev_states; /* temp array mapping each state to previous one */
/* we just use folder as a flag in utf8 */
- const U8 * const folder = ( flags == EXACTF
- ? PL_fold
- : ( flags == EXACTFL
- ? PL_fold_locale
- : NULL
- )
- );
+ const U8 * folder = NULL;
#ifdef DEBUGGING
const U32 data_slot = add_data( pRExC_state, 4, "tuuu" );
PERL_UNUSED_ARG(depth);
#endif
+ switch (flags) {
+ case EXACTFU: folder = PL_fold_latin1; break;
+ case EXACTF: folder = PL_fold; break;
+ case EXACTFL: folder = PL_fold_locale; break;
+ }
+
trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
trie->refcount = 1;
trie->startstate = 1;
*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
- efficient in terms of memory by ensuring most common value is in the
+ efficient in terms of memory by ensuring the most common value is in the
middle and the least common are on the outside. IMO this would be better
than a most to least common mapping as theres a decent chance the most
common letter will share a node with the least common, meaning the node
- will not be compressable. With a middle is most common approach the worst
+ will not be compressible. With a middle is most common approach the worst
case is when we have the least common nodes twice.
*/
TRIE_STORE_REVCHAR;
}
if ( set_bit ) {
- /* store the codepoint in the bitmap, and if its ascii
- also store its folded equivelent. */
+ /* store the codepoint in the bitmap, and its folded
+ * equivalent. */
TRIE_BITMAP_SET(trie,uvc);
/* store the folded codepoint */
if ( !UTF ) {
/* store first byte of utf8 representation of
- codepoints in the 127 < uvc < 256 range */
- if (127 < uvc && uvc < 192) {
- TRIE_BITMAP_SET(trie,194);
- } else if (191 < uvc ) {
- TRIE_BITMAP_SET(trie,195);
- /* && uvc < 256 -- we know uvc is < 256 already */
+ variant codepoints */
+ if (! UNI_IS_INVARIANT(uvc)) {
+ TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc));
}
}
set_bit = 0; /* We've done our bit :-) */
We then construct the trie using only the .next slots of the entry
structs.
- We use the .check field of the first entry of the node temporarily to
+ We use the .check field of the first entry of the node temporarily to
make compression both faster and easier by keeping track of how many non
zero fields are in the node.
- Each states[] entry contains a .base field which indicates the
index in the state[] array wheres its transition data is stored.
- - If .base is 0 there are no valid transitions from that node.
+ - If .base is 0 there are no valid transitions from that node.
- If .base is nonzero then charid is added to it to find an entry in
the trans array.
XXX - wrong maybe?
The following process inplace converts the table to the compressed
- table: We first do not compress the root node 1,and mark its all its
+ table: We first do not compress the root node 1,and mark all its
.check pointers as 1 and set its .base pointer as 1 as well. This
- allows to do a DFA construction from the compressed table later, and
- ensures that any .base pointers we calculate later are greater than
- 0.
+ allows us to do a DFA construction from the compressed table later,
+ and ensures that any .base pointers we calculate later are greater
+ than 0.
- We set 'pos' to indicate the first entry of the second node.
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;
depending on whether the thing following (in 'last') is a branch
or not and whther first is the startbranch (ie is it a sub part of
the alternation or is it the whole thing.)
- Assuming its a sub part we conver the EXACT otherwise we convert
+ Assuming its a sub part we convert the EXACT otherwise we convert
the whole branch sequence, including the first.
*/
/* Find the node we are going to overwrite */
if (trie->jump)
trie->jump[0] = (U16)(nextbranch - convert);
- /* XXXX */
- if ( !trie->states[trie->startstate].wordnum && trie->bitmap &&
- ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
+ /* 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
+ * then convert the TRIE node into a TRIEC node, with the bitmap
+ * embedded inline in the opcode - this is hypothetically faster.
+ */
+ if ( !trie->states[trie->startstate].wordnum
+ && trie->bitmap
+ && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
{
OP( convert ) = TRIEC;
Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
* so, point the first word's .prev field at the second word. If the
* second already has a .prev field set, stop now. This will be the
* case either if we've already processed that word's accept state,
- * or that that state had multiple words, and the overspill words
- * were already linked up earlier.
+ * or that state had multiple words, and the overspill words were
+ * already linked up earlier.
*/
{
U16 word;
STATIC void
S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source, regnode *stclass, U32 depth)
{
-/* The Trie is constructed and compressed now so we can build a fail array now if its needed
+/* The Trie is constructed and compressed now so we can build a fail array if it's needed
This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
"Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
ISBN 0-201-10088-6
We find the fail state for each state in the trie, this state is the longest proper
- suffix of the current states 'word' that is also a proper prefix of another word in our
- trie. State 1 represents the word '' and is the thus the default fail state. This allows
+ suffix of the current state's 'word' that is also a proper prefix of another word in our
+ trie. State 1 represents the word '' and is thus the default fail state. This allows
the DFA not to have to restart after its tried and failed a word at a given point, it
simply continues as though it had been matching the other word in the first place.
Consider
'abcdgu'=~/abcdefg|cdgu/
When we get to 'd' we are still matching the first word, we would encounter 'g' which would
- fail, which would bring use to the state representing 'd' in the second word where we would
- try 'g' and succeed, prodceding to match 'cdgu'.
+ fail, which would bring us to the state representing 'd' in the second word where we would
+ try 'g' and succeed, proceeding to match 'cdgu'.
*/
/* add a fail transition */
const U32 trie_offset = ARG(source);
}
#endif
}
-
- if (UTF && ( OP(scan) == EXACTF ) && ( STR_LEN(scan) >= 6 ) ) {
+#define GREEK_SMALL_LETTER_IOTA_WITH_DIALYTIKA_AND_TONOS 0x0390
+#define IOTA_D_T GREEK_SMALL_LETTER_IOTA_WITH_DIALYTIKA_AND_TONOS
+#define GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS 0x03B0
+#define UPSILON_D_T GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS
+
+ if (UTF
+ && ( OP(scan) == EXACTF || OP(scan) == EXACTFU)
+ && ( STR_LEN(scan) >= 6 ) )
+ {
/*
Two problematic code points in Unicode casefolding of EXACT nodes:
return stopnow;
}
-/* REx optimizer. Converts nodes into quickier variants "in place".
+/* REx optimizer. Converts nodes into quicker variants "in place".
Finds fixed substrings. */
/* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
SAVEFREEPV(and_withp)
/* this is a chain of data about sub patterns we are processing that
- need to be handled seperately/specially in study_chunk. Its so
+ need to be handled separately/specially in study_chunk. Its so
we can simulate recursion without losing state. */
struct scan_frame;
typedef struct scan_frame {
which would be constructed from a pattern like /A|LIST|OF|WORDS/
- If we can find such a subseqence we need to turn the first
+ If we can find such a subsequence we need to turn the first
element into a trie and then add the subsequent branch exact
strings to the trie.
We have two cases
- 1. patterns where the whole set of branch can be converted.
+ 1. patterns where the whole set of branches can be converted.
2. patterns where only a subset can be converted.
In case 1 we can replace the whole set with a single regop
for the trie. In case 2 we need to keep the start and end
- branchs so
+ branches so
'BRANCH EXACT; BRANCH EXACT; BRANCH X'
becomes BRANCH TRIE; BRANCH X;
If x(1..n)==tail then we can do a simple trie, if not we make
a "jump" trie, such that when we match the appropriate word
- we "jump" to the appopriate tail node. Essentailly we turn
+ we "jump" to the appropriate tail node. Essentially we turn
a nested if into a case structure of sorts.
*/
and noper_next is the same as scan (our current
position in the regex) then the EXACT branch is
a possible optimization target. Once we have
- two or more consequetive such branches we can
+ two or more consecutive such branches we can
create a trie of the EXACT's contents and stich
it in place. If the sequence represents all of
the branches we eliminate the whole thing and
/* Check whether it is compatible with what we know already! */
int compat = 1;
+
+ /* If compatible, we or it in below. It is compatible if is
+ * in the bitmp and either 1) its bit or its fold is set, or 2)
+ * it's for a locale. Even if there isn't unicode semantics
+ * here, at runtime there may be because of matching against a
+ * utf8 string, so accept a possible false positive for
+ * latin1-range folds */
if (uc >= 0x100 ||
(!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
&& !ANYOF_BITMAP_TEST(data->start_class, uc)
- && (!(data->start_class->flags & ANYOF_FOLD)
- || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
+ && (!(data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD)
+ || !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
)
compat = 0;
ANYOF_CLASS_ZERO(data->start_class);
if (flags & SCF_DO_STCLASS_AND) {
/* Check whether it is compatible with what we know already! */
int compat = 1;
-
if (uc >= 0x100 ||
- (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
- && !ANYOF_BITMAP_TEST(data->start_class, uc)
- && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
+ (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
+ && !ANYOF_BITMAP_TEST(data->start_class, uc)
+ && !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
+ {
compat = 0;
+ }
ANYOF_CLASS_ZERO(data->start_class);
ANYOF_BITMAP_ZERO(data->start_class);
if (compat) {
ANYOF_BITMAP_SET(data->start_class, uc);
data->start_class->flags &= ~ANYOF_EOS;
- data->start_class->flags |= ANYOF_FOLD;
- if (OP(scan) == EXACTFL)
+ data->start_class->flags |= ANYOF_LOC_NONBITMAP_FOLD;
+ if (OP(scan) == EXACTFL) {
data->start_class->flags |= ANYOF_LOCALE;
+ }
+ else {
+
+ /* Also set the other member of the fold pair. In case
+ * that unicode semantics is called for at runtime, use
+ * the full latin1 fold. (Can't do this for locale,
+ * because not known until runtime */
+ ANYOF_BITMAP_SET(data->start_class, PL_fold_latin1[uc]);
+ }
}
}
else if (flags & SCF_DO_STCLASS_OR) {
- if (data->start_class->flags & ANYOF_FOLD) {
+ if (data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD) {
/* false positive possible if the class is case-folded.
Assume that the locale settings are the same... */
- if (uc < 0x100)
+ if (uc < 0x100) {
ANYOF_BITMAP_SET(data->start_class, uc);
+ if (OP(scan) != EXACTFL) {
+
+ /* And set the other member of the fold pair, but
+ * can't do that in locale because not known until
+ * run-time */
+ ANYOF_BITMAP_SET(data->start_class,
+ PL_fold_latin1[uc]);
+ }
+ }
data->start_class->flags &= ~ANYOF_EOS;
}
cl_and(data->start_class, and_withp);
f |= SCF_DO_STCLASS_AND;
f &= ~SCF_DO_STCLASS_OR;
}
- /* These are the cases when once a subexpression
- fails at a particular position, it cannot succeed
- even after backtracking at the enclosing scope.
-
- XXXX what if minimal match and we are at the
- initial run of {n,m}? */
- if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
+ /* Exclude from super-linear cache processing any {n,m}
+ regops for which the combination of input pos and regex
+ pos is not enough information to determine if a match
+ will be possible.
+
+ For example, in the regex /foo(bar\s*){4,8}baz/ with the
+ regex pos at the \s*, the prospects for a match depend not
+ only on the input position but also on how many (bar\s*)
+ repeats into the {4,8} we are. */
+ if ((mincount > 1) || (maxcount > 1 && maxcount != REG_INFTY))
f &= ~SCF_WHILEM_VISITED_POS;
/* This will finish on WHILEM, setting scan, or on NULL: */
#ifdef DEBUGGING
OP(nxt1 + 1) = OPTIMIZED; /* was count. */
OP(nxt + 1) = OPTIMIZED; /* was count. */
- NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
- NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
+ NEXT_OFF(nxt1 + 1) = 0; /* just for consistency. */
+ NEXT_OFF(nxt + 1) = 0; /* just for consistency. */
#endif
#if 0
while ( nxt1 && (OP(nxt1) != WHILEM)) {
regnode *nnxt = regnext(nxt1);
-
if (nnxt == nxt) {
if (reg_off_by_arg[OP(nxt1)])
ARG_SET(nxt1, nxt2 - nxt1);
else if ((OP(oscan) == CURLYX)
&& (flags & SCF_WHILEM_VISITED_POS)
/* See the comment on a similar expression above.
- However, this time it not a subexpression
+ However, this time it's not a subexpression
we care about, but the expression itself. */
&& (maxcount == REG_INFTY)
&& data && ++data->whilem_c < 16) {
if (UTF)
old = utf8_hop((U8*)s, old) - (U8*)s;
-
l -= old;
/* Get the added string: */
last_str = newSVpvn_utf8(s + old, l, UTF);
NEXT_OFF(oscan) += NEXT_OFF(next);
}
continue;
- default: /* REF and CLUMP only? */
+ default: /* REF, ANYOFV, and CLUMP only? */
if (flags & SCF_DO_SUBSTR) {
SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
data->longest = &(data->longest_float);
if (flags & SCF_DO_STCLASS_AND) {
for (value = 0; value < 256; value++)
if (!is_VERTWS_cp(value))
- ANYOF_BITMAP_CLEAR(data->start_class, value);
- }
- else {
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ else {
for (value = 0; value < 256; value++)
if (is_VERTWS_cp(value))
- ANYOF_BITMAP_SET(data->start_class, value);
- }
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
if (flags & SCF_DO_STCLASS_OR)
cl_and(data->start_class, and_withp);
flags &= ~SCF_DO_STCLASS;
data->pos_delta += 1;
data->longest = &(data->longest_float);
}
-
}
else if (OP(scan) == FOLDCHAR) {
- int d = ARG(scan)==0xDF ? 1 : 2;
+ int d = ARG(scan) == LATIN_SMALL_LETTER_SHARP_S ? 1 : 2;
flags &= ~SCF_DO_STCLASS;
min += 1;
delta += d;
goto do_default;
if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
- || (data->start_class->flags & ANYOF_CLASS));
+ || ANYOF_CLASS_TEST_ANY_SET(data->start_class));
cl_anything(pRExC_state, data->start_class);
}
if (flags & SCF_DO_STCLASS_AND || !value)
if (flags & SCF_DO_STCLASS_AND) {
if (!(data->start_class->flags & ANYOF_LOCALE)) {
ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
- for (value = 0; value < 256; value++)
- if (!isALNUM(value))
- ANYOF_BITMAP_CLEAR(data->start_class, value);
+ if (OP(scan) == ALNUMU) {
+ for (value = 0; value < 256; value++) {
+ if (!isWORDCHAR_L1(value)) {
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ } else {
+ for (value = 0; value < 256; value++) {
+ if (!isALNUM(value)) {
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ }
}
}
else {
if (data->start_class->flags & ANYOF_LOCALE)
ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
- else {
- for (value = 0; value < 256; value++)
- if (isALNUM(value))
- ANYOF_BITMAP_SET(data->start_class, value);
- }
- }
- break;
- case ALNUML:
- if (flags & SCF_DO_STCLASS_AND) {
- if (data->start_class->flags & ANYOF_LOCALE)
- ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
- }
- else {
- ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
- data->start_class->flags |= ANYOF_LOCALE;
+ else if (OP(scan) == ALNUMU) {
+ for (value = 0; value < 256; value++) {
+ if (isWORDCHAR_L1(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ } else {
+ for (value = 0; value < 256; value++) {
+ if (isALNUM(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ }
}
break;
case NALNUM:
if (flags & SCF_DO_STCLASS_AND) {
if (!(data->start_class->flags & ANYOF_LOCALE)) {
ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
- for (value = 0; value < 256; value++)
- if (isALNUM(value))
- ANYOF_BITMAP_CLEAR(data->start_class, value);
+ if (OP(scan) == NALNUMU) {
+ for (value = 0; value < 256; value++) {
+ if (isWORDCHAR_L1(value)) {
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ } else {
+ for (value = 0; value < 256; value++) {
+ if (isALNUM(value)) {
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ }
}
}
else {
if (data->start_class->flags & ANYOF_LOCALE)
ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
else {
- for (value = 0; value < 256; value++)
- if (!isALNUM(value))
- ANYOF_BITMAP_SET(data->start_class, value);
+ if (OP(scan) == NALNUMU) {
+ for (value = 0; value < 256; value++) {
+ if (! isWORDCHAR_L1(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ } else {
+ for (value = 0; value < 256; value++) {
+ if (! isALNUM(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ }
}
}
break;
- case NALNUML:
- if (flags & SCF_DO_STCLASS_AND) {
- if (data->start_class->flags & ANYOF_LOCALE)
- ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
- }
- else {
- data->start_class->flags |= ANYOF_LOCALE;
- ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
- }
- break;
case SPACE:
if (flags & SCF_DO_STCLASS_AND) {
if (!(data->start_class->flags & ANYOF_LOCALE)) {
ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
- for (value = 0; value < 256; value++)
- if (!isSPACE(value))
- ANYOF_BITMAP_CLEAR(data->start_class, value);
+ if (OP(scan) == SPACEU) {
+ for (value = 0; value < 256; value++) {
+ if (!isSPACE_L1(value)) {
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ } else {
+ for (value = 0; value < 256; value++) {
+ if (!isSPACE(value)) {
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ }
}
}
else {
- if (data->start_class->flags & ANYOF_LOCALE)
+ if (data->start_class->flags & ANYOF_LOCALE) {
ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
- else {
- for (value = 0; value < 256; value++)
- if (isSPACE(value))
- ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ else if (OP(scan) == SPACEU) {
+ for (value = 0; value < 256; value++) {
+ if (isSPACE_L1(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ } else {
+ for (value = 0; value < 256; value++) {
+ if (isSPACE(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
}
}
break;
- case SPACEL:
- if (flags & SCF_DO_STCLASS_AND) {
- if (data->start_class->flags & ANYOF_LOCALE)
- ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
- }
- else {
- data->start_class->flags |= ANYOF_LOCALE;
- ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
- }
- break;
case NSPACE:
if (flags & SCF_DO_STCLASS_AND) {
if (!(data->start_class->flags & ANYOF_LOCALE)) {
ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
- for (value = 0; value < 256; value++)
- if (isSPACE(value))
- ANYOF_BITMAP_CLEAR(data->start_class, value);
+ if (OP(scan) == NSPACEU) {
+ for (value = 0; value < 256; value++) {
+ if (isSPACE_L1(value)) {
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ } else {
+ for (value = 0; value < 256; value++) {
+ if (isSPACE(value)) {
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ }
}
}
else {
if (data->start_class->flags & ANYOF_LOCALE)
ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
- else {
- for (value = 0; value < 256; value++)
- if (!isSPACE(value))
- ANYOF_BITMAP_SET(data->start_class, value);
- }
- }
- break;
- case NSPACEL:
- if (flags & SCF_DO_STCLASS_AND) {
- if (data->start_class->flags & ANYOF_LOCALE) {
- ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
- for (value = 0; value < 256; value++)
- if (!isSPACE(value))
- ANYOF_BITMAP_CLEAR(data->start_class, value);
- }
- }
- else {
- data->start_class->flags |= ANYOF_LOCALE;
- ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
+ else if (OP(scan) == NSPACEU) {
+ for (value = 0; value < 256; value++) {
+ if (!isSPACE_L1(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ }
+ else {
+ for (value = 0; value < 256; value++) {
+ if (!isSPACE(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ }
}
break;
case DIGIT:
else {
for (value = 0; value < 256; value++)
if (isDIGIT(value))
- ANYOF_BITMAP_SET(data->start_class, value);
+ ANYOF_BITMAP_SET(data->start_class, value);
}
}
break;
else {
for (value = 0; value < 256; value++)
if (!isDIGIT(value))
- ANYOF_BITMAP_SET(data->start_class, value);
+ ANYOF_BITMAP_SET(data->start_class, value);
}
}
break;
int f = 0;
/* We use SAVEFREEPV so that when the full compile
is finished perl will clean up the allocated
- minlens when its all done. This was we don't
+ 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.
*/
#endif
REGEXP *
-Perl_re_compile(pTHX_ SV * const pattern, U32 pm_flags)
+Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
{
dVAR;
REGEXP *rx;
regnode *scan;
I32 flags;
I32 minlen = 0;
+ U32 pm_flags;
+
+ /* these are all flags - maybe they should be turned
+ * into a single int with different bit masks */
+ I32 sawlookahead = 0;
I32 sawplus = 0;
I32 sawopen = 0;
+ bool used_setjump = FALSE;
+
U8 jump_ret = 0;
dJMPENV;
scan_data_t data;
DEBUG_r(if (!PL_colorset) reginitcolors());
RExC_utf8 = RExC_orig_utf8 = SvUTF8(pattern);
+ RExC_uni_semantics = 0;
-
+ /****************** LONG JUMP TARGET HERE***********************/
/* Longjmp back to here if have to switch in midstream to utf8 */
if (! RExC_orig_utf8) {
JMPENV_PUSH(jump_ret);
+ used_setjump = TRUE;
}
if (jump_ret == 0) { /* First time through */
- exp = SvPV(pattern, plen);
- xend = exp + plen;
+ exp = SvPV(pattern, plen);
+ xend = exp + plen;
+ /* ignore the utf8ness if the pattern is 0 length */
+ if (plen == 0) {
+ RExC_utf8 = RExC_orig_utf8 = 0;
+ }
DEBUG_COMPILE_r({
SV *dsv= sv_newmortal();
restudied = 0;
#endif
+ /* Set to use unicode semantics if the pattern is in utf8 and has the
+ * 'depends' charset specified, as it means unicode when utf8 */
+ pm_flags = orig_pm_flags;
+
+ if (RExC_utf8 && get_regex_charset(pm_flags) == REGEX_DEPENDS_CHARSET) {
+ set_regex_charset(&pm_flags, REGEX_UNICODE_CHARSET);
+ }
+
RExC_precomp = exp;
RExC_flags = pm_flags;
RExC_sawback = 0;
RExC_seen = 0;
+ RExC_in_lookbehind = 0;
RExC_seen_zerolen = *exp == '^' ? -1 : 0;
RExC_seen_evals = 0;
RExC_extralen = 0;
return(NULL);
}
- /* Here, finished first pass. Get rid of our setjmp, which we added for
- * efficiency only if the passed-in string wasn't in utf8, as shown by
- * RExC_orig_utf8. But if the first pass was redone, that variable will be
- * 1 here even though the original string wasn't utf8, but in this case
- * there will have been a long jump */
- if (jump_ret == UTF8_LONGJMP || ! RExC_orig_utf8) {
+ /* Here, finished first pass. Get rid of any added setjmp */
+ if (used_setjump) {
JMPENV_POP;
}
+
DEBUG_PARSE_r({
PerlIO_printf(Perl_debug_log,
"Required size %"IVdf" nodes\n"
RExC_lastnum=0;
RExC_lastparse=NULL;
});
+
+ /* The first pass could have found things that force Unicode semantics */
+ if ((RExC_utf8 || RExC_uni_semantics)
+ && get_regex_charset(pm_flags) == REGEX_DEPENDS_CHARSET)
+ {
+ set_regex_charset(&pm_flags, REGEX_UNICODE_CHARSET);
+ }
+
/* Small enough for pointer-storage convention?
If extralen==0, this means that we will not need long jumps. */
if (RExC_size >= 0x10000L && RExC_extralen)
r->extflags = pm_flags;
{
bool has_p = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
- bool has_charset = (r->extflags & (RXf_PMf_LOCALE|RXf_PMf_UNICODE));
+ 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 */
* covered by the caret */
const STRLEN wraplen = plen + has_p + has_runon
+ has_default /* If needs a caret */
- + has_charset /* If needs a character set specifier */
+
+ /* If needs a character set specifier */
+ + ((has_charset) ? MAX_CHARSET_NAME_LENGTH : 0)
+ (sizeof(STD_PAT_MODS) - 1)
+ (sizeof("(?:)") - 1);
*p++= DEFAULT_PAT_MOD;
}
if (has_charset) {
- if (r->extflags & RXf_PMf_LOCALE) {
- *p++ = LOCALE_PAT_MOD;
- } else {
- *p++ = UNICODE_PAT_MOD;
- }
+ STRLEN len;
+ const char* const name = get_regex_charset_name(r->extflags, &len);
+ Copy(name, p, len, char);
+ p += len;
}
if (has_p)
*p++ = KEEPCOPY_PAT_MOD; /*'p'*/
}
reStudy:
- r->minlen = minlen = sawplus = sawopen = 0;
+ r->minlen = minlen = sawlookahead = sawplus = sawopen = 0;
Zero(r->substrs, 1, struct reg_substr_data);
#ifdef TRIE_STUDY_OPT
I32 last_close = 0; /* pointed to by data */
regnode *first= scan;
regnode *first_next= regnext(first);
-
/*
* Skip introductions and multiplicators >= 1
* so that we can extract the 'meat' of the pattern that must
/* An OR of *one* alternative - should not happen now. */
(OP(first) == BRANCH && OP(first_next) != BRANCH) ||
/* for now we can't handle lookbehind IFMATCH*/
- (OP(first) == IFMATCH && !first->flags) ||
+ (OP(first) == IFMATCH && !first->flags && (sawlookahead = 1)) ||
(OP(first) == PLUS) ||
(OP(first) == MINMOD) ||
/* An {n,m} with n>0 */
if (PL_regkind[OP(first)] == EXACT) {
if (OP(first) == EXACT)
NOOP; /* Empty, get anchored substr later. */
- else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
+ else
ri->regstclass = first;
}
#ifdef TRIE_STCLASS
first = NEXTOPER(first);
goto again;
}
- if (sawplus && (!sawopen || !RExC_sawback)
+ if (sawplus && !sawlookahead && (!sawopen || !RExC_sawback)
&& !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
/* x+ must match at the 1st pos of run of x's */
r->intflags |= PREGf_SKIP;
if (ri->regstclass
&& (OP(ri->regstclass) == REG_ANY || OP(ri->regstclass) == SANY))
ri->regstclass = NULL;
+
+ /* If the synthetic start class were to ever be used when EOS is set,
+ * that bit would have to be cleared, as it is shared with another */
if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset)
&& stclass_flag
&& !(data.start_class->flags & ANYOF_EOS)
r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8
= r->float_substr = r->float_utf8 = NULL;
+
+ /* If the synthetic start class were to ever be used when EOS is set,
+ * that bit would have to be cleared, as it is shared with another */
if (!(data.start_class->flags & ANYOF_EOS)
&& !cl_is_anything(data.start_class))
{
else {
regnode *first = ri->program + 1;
U8 fop = OP(first);
- U8 nop = OP(NEXTOPER(first));
-
- if (PL_regkind[fop] == NOTHING && nop == END)
+
+ if (PL_regkind[fop] == NOTHING && OP(NEXTOPER(first)) == END)
r->extflags |= RXf_NULL;
- else if (PL_regkind[fop] == BOL && nop == END)
+ else if (PL_regkind[fop] == BOL && OP(NEXTOPER(first)) == END)
r->extflags |= RXf_START_ONLY;
- else if (fop == PLUS && nop ==SPACE && OP(regnext(first))==END)
+ else if (fop == PLUS && OP(NEXTOPER(first)) == SPACE
+ && OP(regnext(first)) == END)
r->extflags |= RXf_WHITE;
}
#endif
DEBUG_PARSE_MSG((funcname)); \
PerlIO_printf(Perl_debug_log,fmt "\n",args); \
})
-/*
- - reg - regular expression, i.e. main body or parenthesized thing
- *
- * Caller must absorb opening parenthesis.
+
+/* This section of code defines the inversion list object and its methods. The
+ * interfaces are highly subject to change, so as much as possible is static to
+ * this file. An inversion list is here implemented as a malloc'd C array with
+ * some added info. More will be coming when functionality is added later.
*
- * Combining parenthesis handling with the base level of regular expression
- * is a trifle forced, but the need to tie the tails of the branches to what
- * follows makes it hard to avoid.
- */
-#define REGTAIL(x,y,z) regtail((x),(y),(z),depth+1)
-#ifdef DEBUGGING
-#define REGTAIL_STUDY(x,y,z) regtail_study((x),(y),(z),depth+1)
-#else
-#define REGTAIL_STUDY(x,y,z) regtail((x),(y),(z),depth+1)
-#endif
+ * Some of the methods should always be private to the implementation, and some
+ * should eventually be made public */
-STATIC regnode *
-S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
- /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
+#define INVLIST_INITIAL_LEN 10
+#define INVLIST_ARRAY_KEY "array"
+#define INVLIST_MAX_KEY "max"
+#define INVLIST_LEN_KEY "len"
+
+PERL_STATIC_INLINE UV*
+S_invlist_array(pTHX_ HV* const invlist)
{
- dVAR;
- register regnode *ret; /* Will be the head of the group. */
- register regnode *br;
- register regnode *lastbr;
- register regnode *ender = NULL;
- register I32 parno = 0;
- I32 flags;
- U32 oregflags = RExC_flags;
- bool have_branch = 0;
- bool is_open = 0;
- I32 freeze_paren = 0;
- I32 after_freeze = 0;
+ /* Returns the pointer to the inversion list's array. Every time the
+ * length changes, this needs to be called in case malloc or realloc moved
+ * it */
- /* for (?g), (?gc), and (?o) warnings; warning
- about (?c) will warn about (?g) -- japhy */
+ SV** list_ptr = hv_fetchs(invlist, INVLIST_ARRAY_KEY, FALSE);
-#define WASTED_O 0x01
-#define WASTED_G 0x02
-#define WASTED_C 0x04
-#define WASTED_GC (0x02|0x04)
- I32 wastedflags = 0x00;
+ PERL_ARGS_ASSERT_INVLIST_ARRAY;
- char * parse_start = RExC_parse; /* MJD */
- char * const oregcomp_parse = RExC_parse;
+ if (list_ptr == NULL) {
+ Perl_croak(aTHX_ "panic: inversion list without a '%s' element",
+ INVLIST_ARRAY_KEY);
+ }
- GET_RE_DEBUG_FLAGS_DECL;
+ return INT2PTR(UV *, SvUV(*list_ptr));
+}
- PERL_ARGS_ASSERT_REG;
- DEBUG_PARSE("reg ");
+PERL_STATIC_INLINE void
+S_invlist_set_array(pTHX_ HV* const invlist, const UV* const array)
+{
+ PERL_ARGS_ASSERT_INVLIST_SET_ARRAY;
- *flagp = 0; /* Tentatively. */
+ /* Sets the array stored in the inversion list to the memory beginning with
+ * the parameter */
+ if (hv_stores(invlist, INVLIST_ARRAY_KEY, newSVuv(PTR2UV(array))) == NULL) {
+ Perl_croak(aTHX_ "panic: can't store '%s' entry in inversion list",
+ INVLIST_ARRAY_KEY);
+ }
+}
- /* Make an OPEN node, if parenthesized. */
- if (paren) {
- if ( *RExC_parse == '*') { /* (*VERB:ARG) */
- char *start_verb = RExC_parse;
- STRLEN verb_len = 0;
- char *start_arg = NULL;
- unsigned char op = 0;
- int argok = 1;
- int internal_argval = 0; /* internal_argval is only useful if !argok */
- while ( *RExC_parse && *RExC_parse != ')' ) {
- if ( *RExC_parse == ':' ) {
- start_arg = RExC_parse + 1;
- break;
- }
- RExC_parse++;
- }
- ++start_verb;
- verb_len = RExC_parse - start_verb;
- if ( start_arg ) {
- RExC_parse++;
- while ( *RExC_parse && *RExC_parse != ')' )
- RExC_parse++;
- if ( *RExC_parse != ')' )
- vFAIL("Unterminated verb pattern argument");
- if ( RExC_parse == start_arg )
- start_arg = NULL;
- } else {
- if ( *RExC_parse != ')' )
- vFAIL("Unterminated verb pattern");
- }
-
- switch ( *start_verb ) {
- case 'A': /* (*ACCEPT) */
- if ( memEQs(start_verb,verb_len,"ACCEPT") ) {
- op = ACCEPT;
- internal_argval = RExC_nestroot;
- }
- break;
- case 'C': /* (*COMMIT) */
- if ( memEQs(start_verb,verb_len,"COMMIT") )
- op = COMMIT;
- break;
- case 'F': /* (*FAIL) */
- if ( verb_len==1 || memEQs(start_verb,verb_len,"FAIL") ) {
- op = OPFAIL;
- argok = 0;
- }
- break;
- case ':': /* (*:NAME) */
- case 'M': /* (*MARK:NAME) */
- if ( verb_len==0 || memEQs(start_verb,verb_len,"MARK") ) {
- op = MARKPOINT;
- argok = -1;
- }
- break;
- case 'P': /* (*PRUNE) */
- if ( memEQs(start_verb,verb_len,"PRUNE") )
- op = PRUNE;
- break;
- 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") ) {
+PERL_STATIC_INLINE UV
+S_invlist_len(pTHX_ HV* const invlist)
+{
+ /* Returns the current number of elements in the inversion list's array */
+
+ SV** len_ptr = hv_fetchs(invlist, INVLIST_LEN_KEY, FALSE);
+
+ PERL_ARGS_ASSERT_INVLIST_LEN;
+
+ if (len_ptr == NULL) {
+ Perl_croak(aTHX_ "panic: inversion list without a '%s' element",
+ INVLIST_LEN_KEY);
+ }
+
+ return SvUV(*len_ptr);
+}
+
+PERL_STATIC_INLINE UV
+S_invlist_max(pTHX_ HV* const invlist)
+{
+ /* Returns the maximum number of elements storable in the inversion list's
+ * array, without having to realloc() */
+
+ SV** max_ptr = hv_fetchs(invlist, INVLIST_MAX_KEY, FALSE);
+
+ PERL_ARGS_ASSERT_INVLIST_MAX;
+
+ if (max_ptr == NULL) {
+ Perl_croak(aTHX_ "panic: inversion list without a '%s' element",
+ INVLIST_MAX_KEY);
+ }
+
+ return SvUV(*max_ptr);
+}
+
+PERL_STATIC_INLINE void
+S_invlist_set_len(pTHX_ HV* const invlist, const UV len)
+{
+ /* Sets the current number of elements stored in the inversion list */
+
+ PERL_ARGS_ASSERT_INVLIST_SET_LEN;
+
+ if (len != 0 && len > invlist_max(invlist)) {
+ Perl_croak(aTHX_ "panic: Can't make '%s=%"UVuf"' more than %s=%"UVuf" in inversion list", INVLIST_LEN_KEY, len, INVLIST_MAX_KEY, invlist_max(invlist));
+ }
+
+ if (hv_stores(invlist, INVLIST_LEN_KEY, newSVuv(len)) == NULL) {
+ Perl_croak(aTHX_ "panic: can't store '%s' entry in inversion list",
+ INVLIST_LEN_KEY);
+ }
+}
+
+PERL_STATIC_INLINE void
+S_invlist_set_max(pTHX_ HV* const invlist, const UV max)
+{
+
+ /* Sets the maximum number of elements storable in the inversion list
+ * without having to realloc() */
+
+ PERL_ARGS_ASSERT_INVLIST_SET_MAX;
+
+ if (max < invlist_len(invlist)) {
+ Perl_croak(aTHX_ "panic: Can't make '%s=%"UVuf"' less than %s=%"UVuf" in inversion list", INVLIST_MAX_KEY, invlist_len(invlist), INVLIST_LEN_KEY, invlist_max(invlist));
+ }
+
+ if (hv_stores(invlist, INVLIST_MAX_KEY, newSVuv(max)) == NULL) {
+ Perl_croak(aTHX_ "panic: can't store '%s' entry in inversion list",
+ INVLIST_LEN_KEY);
+ }
+}
+
+HV*
+Perl__new_invlist(pTHX_ IV initial_size)
+{
+
+ /* Return a pointer to a newly constructed inversion list, with enough
+ * space to store 'initial_size' elements. If that number is negative, a
+ * system default is used instead */
+
+ HV* invlist = newHV();
+ UV* list;
+
+ if (initial_size < 0) {
+ initial_size = INVLIST_INITIAL_LEN;
+ }
+
+ /* Allocate the initial space */
+ Newx(list, initial_size, UV);
+ invlist_set_array(invlist, list);
+
+ /* set_len has to come before set_max, as the latter inspects the len */
+ invlist_set_len(invlist, 0);
+ invlist_set_max(invlist, initial_size);
+
+ return invlist;
+}
+
+PERL_STATIC_INLINE void
+S_invlist_destroy(pTHX_ HV* const invlist)
+{
+ /* Inversion list destructor */
+
+ SV** list_ptr = hv_fetchs(invlist, INVLIST_ARRAY_KEY, FALSE);
+
+ PERL_ARGS_ASSERT_INVLIST_DESTROY;
+
+ if (list_ptr != NULL) {
+ Safefree(INT2PTR(UV *, SvUV(*list_ptr)));
+ }
+}
+
+STATIC void
+S_invlist_extend(pTHX_ HV* const invlist, const UV new_max)
+{
+ /* Change the maximum size of an inversion list (up or down) */
+
+ UV* orig_array;
+ UV* array;
+ const UV old_max = invlist_max(invlist);
+
+ PERL_ARGS_ASSERT_INVLIST_EXTEND;
+
+ if (old_max == new_max) { /* If a no-op */
+ return;
+ }
+
+ array = orig_array = invlist_array(invlist);
+ Renew(array, new_max, UV);
+
+ /* If the size change moved the list in memory, set the new one */
+ if (array != orig_array) {
+ invlist_set_array(invlist, array);
+ }
+
+ invlist_set_max(invlist, new_max);
+
+}
+
+PERL_STATIC_INLINE void
+S_invlist_trim(pTHX_ HV* const invlist)
+{
+ PERL_ARGS_ASSERT_INVLIST_TRIM;
+
+ /* Change the length of the inversion list to how many entries it currently
+ * has */
+
+ invlist_extend(invlist, invlist_len(invlist));
+}
+
+/* An element is in an inversion list iff its index is even numbered: 0, 2, 4,
+ * etc */
+
+#define ELEMENT_IN_INVLIST_SET(i) (! ((i) & 1))
+
+void
+Perl__append_range_to_invlist(pTHX_ HV* 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
+ * ones. */
+
+ UV* array = invlist_array(invlist);
+ UV max = invlist_max(invlist);
+ UV len = invlist_len(invlist);
+
+ PERL_ARGS_ASSERT__APPEND_RANGE_TO_INVLIST;
+
+ if (len > 0) {
+
+ /* Here, the existing list is non-empty. The current max entry in the
+ * list is generally the first value not in the set, except when the
+ * set extends to the end of permissible values, in which case it is
+ * the first entry in that final set, and so this call is an attempt to
+ * append out-of-order */
+
+ UV final_element = len - 1;
+ if (array[final_element] > start
+ || ELEMENT_IN_INVLIST_SET(final_element))
+ {
+ Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list");
+ }
+
+ /* Here, it is a legal append. If the new range begins with the first
+ * value not in the set, it is extending the set, so the new first
+ * value not in the set is one greater than the newly extended range.
+ * */
+ if (array[final_element] == start) {
+ if (end != UV_MAX) {
+ array[final_element] = end + 1;
+ }
+ else {
+ /* But if the end is the maximum representable on the machine,
+ * just let the range that this would extend have no end */
+ invlist_set_len(invlist, len - 1);
+ }
+ return;
+ }
+ }
+
+ /* Here the new range doesn't extend any existing set. Add it */
+
+ len += 2; /* Includes an element each for the start and end of range */
+
+ /* If overflows the existing space, extend, which may cause the array to be
+ * moved */
+ if (max < len) {
+ invlist_extend(invlist, len);
+ array = invlist_array(invlist);
+ }
+
+ invlist_set_len(invlist, len);
+
+ /* The next item on the list starts the range, the one after that is
+ * one past the new range. */
+ array[len - 2] = start;
+ if (end != UV_MAX) {
+ array[len - 1] = end + 1;
+ }
+ else {
+ /* But if the end is the maximum representable on the machine, just let
+ * the range have no end */
+ invlist_set_len(invlist, len - 1);
+ }
+}
+
+PERL_STATIC_INLINE HV*
+S_invlist_union(pTHX_ HV* const a, HV* const b)
+{
+ /* Return a new inversion list which is the union of two inversion lists.
+ * The basis for this comes from "Unicode Demystified" Chapter 13 by
+ * Richard Gillam, published by Addison-Wesley, and explained at some
+ * length there. The preface says to incorporate its examples into your
+ * code at your own risk.
+ *
+ * The algorithm is like a merge sort.
+ *
+ * XXX A potential performance improvement is to keep track as we go along
+ * if only one of the inputs contributes to the result, meaning the other
+ * is a subset of that one. In that case, we can skip the final copy and
+ * return the larger of the input lists */
+
+ UV* array_a = invlist_array(a); /* a's array */
+ UV* array_b = invlist_array(b);
+ UV len_a = invlist_len(a); /* length of a's array */
+ UV len_b = invlist_len(b);
+
+ HV* u; /* the resulting union */
+ UV* array_u;
+ UV len_u;
+
+ UV i_a = 0; /* current index into a's array */
+ UV i_b = 0;
+ UV i_u = 0;
+
+ /* running count, as explained in the algorithm source book; items are
+ * stopped accumulating and are output when the count changes to/from 0.
+ * The count is incremented when we start a range that's in the set, and
+ * decremented when we start a range that's not in the set. So its range
+ * is 0 to 2. Only when the count is zero is something not in the set.
+ */
+ UV count = 0;
+
+ PERL_ARGS_ASSERT_INVLIST_UNION;
+
+ /* Size the union for the worst case: that the sets are completely
+ * disjoint */
+ u = _new_invlist(len_a + len_b);
+ array_u = invlist_array(u);
+
+ /* Go through each list item by item, stopping when exhausted one of
+ * them */
+ while (i_a < len_a && i_b < len_b) {
+ UV cp; /* The element to potentially add to the union's array */
+ bool cp_in_set; /* is it in the the input list's set or not */
+
+ /* We need to take one or the other of the two inputs for the union.
+ * Since we are merging two sorted lists, we take the smaller of the
+ * next items. In case of a tie, we take the one that is in its set
+ * first. If we took one not in the set first, it would decrement the
+ * count, possibly to 0 which would cause it to be output as ending the
+ * range, and the next time through we would take the same number, and
+ * output it again as beginning the next range. By doing it the
+ * opposite way, there is no possibility that the count will be
+ * momentarily decremented to 0, and thus the two adjoining ranges will
+ * be seamlessly merged. (In a tie and both are in the set or both not
+ * in the set, it doesn't matter which we take first.) */
+ if (array_a[i_a] < array_b[i_b]
+ || (array_a[i_a] == array_b[i_b] && ELEMENT_IN_INVLIST_SET(i_a)))
+ {
+ cp_in_set = ELEMENT_IN_INVLIST_SET(i_a);
+ cp= array_a[i_a++];
+ }
+ else {
+ cp_in_set = ELEMENT_IN_INVLIST_SET(i_b);
+ cp= array_b[i_b++];
+ }
+
+ /* Here, have chosen which of the two inputs to look at. Only output
+ * if the running count changes to/from 0, which marks the
+ * beginning/end of a range in that's in the set */
+ if (cp_in_set) {
+ if (count == 0) {
+ array_u[i_u++] = cp;
+ }
+ count++;
+ }
+ else {
+ count--;
+ if (count == 0) {
+ array_u[i_u++] = cp;
+ }
+ }
+ }
+
+ /* Here, we are finished going through at least one of the lists, which
+ * means there is something remaining in at most one. We check if the list
+ * that hasn't been exhausted is positioned such that we are in the middle
+ * of a range in its set or not. (We are in the set if the next item in
+ * the array marks the beginning of something not in the set) If in the
+ * set, we decrement 'count'; if 0, there is potentially more to output.
+ * There are four cases:
+ * 1) Both weren't in their sets, count is 0, and remains 0. What's left
+ * in the union is entirely from the non-exhausted set.
+ * 2) Both were in their sets, count is 2. Nothing further should
+ * be output, as everything that remains will be in the exhausted
+ * list's set, hence in the union; decrementing to 1 but not 0 insures
+ * that
+ * 3) the exhausted was in its set, non-exhausted isn't, count is 1.
+ * Nothing further should be output because the union includes
+ * everything from the exhausted set. Not decrementing insures that.
+ * 4) the exhausted wasn't in its set, non-exhausted is, count is 1;
+ * decrementing to 0 insures that we look at the remainder of the
+ * non-exhausted set */
+ if ((i_a != len_a && ! ELEMENT_IN_INVLIST_SET(i_a))
+ || (i_b != len_b && ! ELEMENT_IN_INVLIST_SET(i_b)))
+ {
+ count--;
+ }
+
+ /* The final length is what we've output so far, plus what else is about to
+ * be output. (If 'count' is non-zero, then the input list we exhausted
+ * has everything remaining up to the machine's limit in its set, and hence
+ * in the union, so there will be no further output. */
+ len_u = i_u;
+ if (count == 0) {
+ /* At most one of the subexpressions will be non-zero */
+ len_u += (len_a - i_a) + (len_b - i_b);
+ }
+
+ /* Set result to final length, which can change the pointer to array_u, so
+ * re-find it */
+ if (len_u != invlist_len(u)) {
+ invlist_set_len(u, len_u);
+ invlist_trim(u);
+ array_u = invlist_array(u);
+ }
+
+ /* When 'count' is 0, the list that was exhausted (if one was shorter than
+ * the other) ended with everything above it not in its set. That means
+ * that the remaining part of the union is precisely the same as the
+ * non-exhausted list, so can just copy it unchanged. (If both list were
+ * exhausted at the same time, then the operations below will be both 0.)
+ */
+ if (count == 0) {
+ IV copy_count; /* At most one will have a non-zero copy count */
+ if ((copy_count = len_a - i_a) > 0) {
+ Copy(array_a + i_a, array_u + i_u, copy_count, UV);
+ }
+ else if ((copy_count = len_b - i_b) > 0) {
+ Copy(array_b + i_b, array_u + i_u, copy_count, UV);
+ }
+ }
+
+ return u;
+}
+
+PERL_STATIC_INLINE HV*
+S_invlist_intersection(pTHX_ HV* const a, HV* const b)
+{
+ /* Return the intersection of two inversion lists. The basis for this
+ * comes from "Unicode Demystified" Chapter 13 by Richard Gillam, published
+ * by Addison-Wesley, and explained at some length there. The preface says
+ * to incorporate its examples into your code at your own risk.
+ *
+ * The algorithm is like a merge sort, and is essentially the same as the
+ * union above
+ */
+
+ UV* array_a = invlist_array(a); /* a's array */
+ UV* array_b = invlist_array(b);
+ UV len_a = invlist_len(a); /* length of a's array */
+ UV len_b = invlist_len(b);
+
+ HV* r; /* the resulting intersection */
+ UV* array_r;
+ UV len_r;
+
+ UV i_a = 0; /* current index into a's array */
+ UV i_b = 0;
+ UV i_r = 0;
+
+ /* running count, as explained in the algorithm source book; items are
+ * stopped accumulating and are output when the count changes to/from 2.
+ * The count is incremented when we start a range that's in the set, and
+ * decremented when we start a range that's not in the set. So its range
+ * is 0 to 2. Only when the count is 2 is something in the intersection.
+ */
+ UV count = 0;
+
+ PERL_ARGS_ASSERT_INVLIST_INTERSECTION;
+
+ /* Size the intersection for the worst case: that the intersection ends up
+ * fragmenting everything to be completely disjoint */
+ r= _new_invlist(len_a + len_b);
+ array_r = invlist_array(r);
+
+ /* Go through each list item by item, stopping when exhausted one of
+ * them */
+ while (i_a < len_a && i_b < len_b) {
+ UV cp; /* The element to potentially add to the intersection's
+ array */
+ bool cp_in_set; /* Is it in the input list's set or not */
+
+ /* We need to take one or the other of the two inputs for the union.
+ * Since we are merging two sorted lists, we take the smaller of the
+ * next items. In case of a tie, we take the one that is not in its
+ * set first (a difference from the union algorithm). If we took one
+ * in the set first, it would increment the count, possibly to 2 which
+ * would cause it to be output as starting a range in the intersection,
+ * and the next time through we would take that same number, and output
+ * it again as ending the set. By doing it the opposite of this, we
+ * there is no possibility that the count will be momentarily
+ * incremented to 2. (In a tie and both are in the set or both not in
+ * the set, it doesn't matter which we take first.) */
+ if (array_a[i_a] < array_b[i_b]
+ || (array_a[i_a] == array_b[i_b] && ! ELEMENT_IN_INVLIST_SET(i_a)))
+ {
+ cp_in_set = ELEMENT_IN_INVLIST_SET(i_a);
+ cp= array_a[i_a++];
+ }
+ else {
+ cp_in_set = ELEMENT_IN_INVLIST_SET(i_b);
+ cp= array_b[i_b++];
+ }
+
+ /* Here, have chosen which of the two inputs to look at. Only output
+ * if the running count changes to/from 2, which marks the
+ * beginning/end of a range that's in the intersection */
+ if (cp_in_set) {
+ count++;
+ if (count == 2) {
+ array_r[i_r++] = cp;
+ }
+ }
+ else {
+ if (count == 2) {
+ array_r[i_r++] = cp;
+ }
+ count--;
+ }
+ }
+
+ /* Here, we are finished going through at least one of the sets, which
+ * means there is something remaining in at most one. See the comments in
+ * the union code */
+ if ((i_a != len_a && ! ELEMENT_IN_INVLIST_SET(i_a))
+ || (i_b != len_b && ! ELEMENT_IN_INVLIST_SET(i_b)))
+ {
+ count--;
+ }
+
+ /* The final length is what we've output so far plus what else is in the
+ * intersection. Only 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);
+ }
+
+ /* Set result to final length, which can change the pointer to array_r, so
+ * re-find it */
+ if (len_r != invlist_len(r)) {
+ invlist_set_len(r, len_r);
+ invlist_trim(r);
+ array_r = invlist_array(r);
+ }
+
+ /* Finish outputting any remaining */
+ if (count == 2) { /* Only one of will have a non-zero copy count */
+ IV copy_count;
+ if ((copy_count = len_a - i_a) > 0) {
+ Copy(array_a + i_a, array_r + i_r, copy_count, UV);
+ }
+ else if ((copy_count = len_b - i_b) > 0) {
+ Copy(array_b + i_b, array_r + i_r, copy_count, UV);
+ }
+ }
+
+ return r;
+}
+
+STATIC HV*
+S_add_range_to_invlist(pTHX_ HV* const invlist, const UV start, const UV end)
+{
+ /* Add the range from 'start' to 'end' inclusive to the inversion list's
+ * set. A pointer to the inversion list is returned. This may actually be
+ * a new list, in which case the passed in one has been destroyed */
+
+ HV* range_invlist;
+ HV* added_invlist;
+
+ UV len = invlist_len(invlist);
+
+ PERL_ARGS_ASSERT_ADD_RANGE_TO_INVLIST;
+
+ /* If comes after the final entry, can just append it to the end */
+ if (len == 0
+ || start >= invlist_array(invlist)
+ [invlist_len(invlist) - 1])
+ {
+ _append_range_to_invlist(invlist, start, end);
+ return invlist;
+ }
+
+ /* Here, can't just append things, create and return a new inversion list
+ * which is the union of this range and the existing inversion list */
+ range_invlist = _new_invlist(2);
+ _append_range_to_invlist(range_invlist, start, end);
+
+ added_invlist = invlist_union(invlist, range_invlist);
+
+ /* The passed in list can be freed, as well as our temporary */
+ invlist_destroy(range_invlist);
+ if (invlist != added_invlist) {
+ invlist_destroy(invlist);
+ }
+
+ return added_invlist;
+}
+
+/* End of inversion list object */
+
+/*
+ - reg - regular expression, i.e. main body or parenthesized thing
+ *
+ * Caller must absorb opening parenthesis.
+ *
+ * Combining parenthesis handling with the base level of regular expression
+ * is a trifle forced, but the need to tie the tails of the branches to what
+ * follows makes it hard to avoid.
+ */
+#define REGTAIL(x,y,z) regtail((x),(y),(z),depth+1)
+#ifdef DEBUGGING
+#define REGTAIL_STUDY(x,y,z) regtail_study((x),(y),(z),depth+1)
+#else
+#define REGTAIL_STUDY(x,y,z) regtail((x),(y),(z),depth+1)
+#endif
+
+STATIC regnode *
+S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
+ /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
+{
+ dVAR;
+ register regnode *ret; /* Will be the head of the group. */
+ register regnode *br;
+ register regnode *lastbr;
+ register regnode *ender = NULL;
+ register I32 parno = 0;
+ I32 flags;
+ U32 oregflags = RExC_flags;
+ bool have_branch = 0;
+ bool is_open = 0;
+ I32 freeze_paren = 0;
+ I32 after_freeze = 0;
+
+ /* for (?g), (?gc), and (?o) warnings; warning
+ about (?c) will warn about (?g) -- japhy */
+
+#define WASTED_O 0x01
+#define WASTED_G 0x02
+#define WASTED_C 0x04
+#define WASTED_GC (0x02|0x04)
+ I32 wastedflags = 0x00;
+
+ char * parse_start = RExC_parse; /* MJD */
+ char * const oregcomp_parse = RExC_parse;
+
+ GET_RE_DEBUG_FLAGS_DECL;
+
+ PERL_ARGS_ASSERT_REG;
+ DEBUG_PARSE("reg ");
+
+ *flagp = 0; /* Tentatively. */
+
+
+ /* Make an OPEN node, if parenthesized. */
+ if (paren) {
+ if ( *RExC_parse == '*') { /* (*VERB:ARG) */
+ char *start_verb = RExC_parse;
+ STRLEN verb_len = 0;
+ char *start_arg = NULL;
+ unsigned char op = 0;
+ int argok = 1;
+ int internal_argval = 0; /* internal_argval is only useful if !argok */
+ while ( *RExC_parse && *RExC_parse != ')' ) {
+ if ( *RExC_parse == ':' ) {
+ start_arg = RExC_parse + 1;
+ break;
+ }
+ RExC_parse++;
+ }
+ ++start_verb;
+ verb_len = RExC_parse - start_verb;
+ if ( start_arg ) {
+ RExC_parse++;
+ while ( *RExC_parse && *RExC_parse != ')' )
+ RExC_parse++;
+ if ( *RExC_parse != ')' )
+ vFAIL("Unterminated verb pattern argument");
+ if ( RExC_parse == start_arg )
+ start_arg = NULL;
+ } else {
+ if ( *RExC_parse != ')' )
+ vFAIL("Unterminated verb pattern");
+ }
+
+ switch ( *start_verb ) {
+ case 'A': /* (*ACCEPT) */
+ if ( memEQs(start_verb,verb_len,"ACCEPT") ) {
+ op = ACCEPT;
+ internal_argval = RExC_nestroot;
+ }
+ break;
+ case 'C': /* (*COMMIT) */
+ if ( memEQs(start_verb,verb_len,"COMMIT") )
+ op = COMMIT;
+ break;
+ case 'F': /* (*FAIL) */
+ if ( verb_len==1 || memEQs(start_verb,verb_len,"FAIL") ) {
+ op = OPFAIL;
+ argok = 0;
+ }
+ break;
+ case ':': /* (*:NAME) */
+ case 'M': /* (*MARK:NAME) */
+ if ( verb_len==0 || memEQs(start_verb,verb_len,"MARK") ) {
+ op = MARKPOINT;
+ argok = -1;
+ }
+ break;
+ case 'P': /* (*PRUNE) */
+ if ( memEQs(start_verb,verb_len,"PRUNE") )
+ op = PRUNE;
+ break;
+ 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;
}
SvREFCNT_inc_simple_void(sv_dat);
}
RExC_sawback = 1;
- ret = reganode(pRExC_state,
- (U8)(FOLD ? (LOC ? NREFFL : NREFF) : NREF),
- num);
+ ret = reganode(pRExC_state,
+ ((! FOLD)
+ ? NREF
+ : (UNI_SEMANTICS)
+ ? NREFFU
+ : (LOC)
+ ? NREFFL
+ : NREFF),
+ num);
*flagp |= HASWIDTH;
Set_Node_Offset(ret, parse_start+1);
if (SIZE_ONLY) {
HE *he_str;
SV *sv_dat = NULL;
- if (!svname) /* shouldnt happen */
+ if (!svname) /* shouldn't happen */
Perl_croak(aTHX_
"panic: reg_scan_name returned NULL");
if (!RExC_paren_names) {
goto capturing_parens;
}
RExC_seen |= REG_SEEN_LOOKBEHIND;
+ RExC_in_lookbehind++;
RExC_parse++;
case '=': /* (?=...) */
RExC_seen_zerolen++;
/*
Diagram of capture buffer numbering.
Top line is the normal capture buffer numbers
- Botton line is the negative indexing as from
+ Bottom line is the negative indexing as from
the X (the (?-2))
+ 1 2 3 4 5 X 6 7
ENTER;
Perl_save_re_context(aTHX);
- rop = sv_compile_2op(sv, &sop, "re", &pad);
+ rop = Perl_sv_compile_2op_is_broken(aTHX_ sv, &sop, "re", &pad);
sop->op_private |= OPpREFCOUNTED;
/* re_dup will OpREFCNT_inc */
OpREFCNT_set(sop, 1);
that follow */
has_use_defaults = TRUE;
STD_PMMOD_FLAGS_CLEAR(&RExC_flags);
- RExC_flags &= ~(RXf_PMf_LOCALE|RXf_PMf_UNICODE);
+ set_regex_charset(&RExC_flags, (RExC_utf8 || RExC_uni_semantics)
+ ? REGEX_UNICODE_CHARSET
+ : REGEX_DEPENDS_CHARSET);
goto parse_flags;
default:
--RExC_parse;
U32 posflags = 0, negflags = 0;
U32 *flagsp = &posflags;
bool has_charset_modifier = 0;
+ regex_charset cs = REGEX_DEPENDS_CHARSET;
while (*RExC_parse) {
/* && strchr("iogcmsx", *RExC_parse) */
if (has_charset_modifier || flagsp == &negflags) {
goto fail_modifiers;
}
- *flagsp &= ~RXf_PMf_UNICODE;
- *flagsp |= RXf_PMf_LOCALE;
+ cs = REGEX_LOCALE_CHARSET;
has_charset_modifier = 1;
break;
case UNICODE_PAT_MOD:
if (has_charset_modifier || flagsp == &negflags) {
goto fail_modifiers;
}
- *flagsp &= ~RXf_PMf_LOCALE;
- *flagsp |= RXf_PMf_UNICODE;
+ cs = REGEX_UNICODE_CHARSET;
has_charset_modifier = 1;
break;
- case DUAL_PAT_MOD:
+ case ASCII_RESTRICT_PAT_MOD:
+ if (has_charset_modifier || flagsp == &negflags) {
+ goto fail_modifiers;
+ }
+ cs = REGEX_ASCII_RESTRICTED_CHARSET;
+ has_charset_modifier = 1;
+ break;
+ case DEPENDS_PAT_MOD:
if (has_use_defaults
|| has_charset_modifier
|| flagsp == &negflags)
{
goto fail_modifiers;
}
- *flagsp &= ~(RXf_PMf_LOCALE|RXf_PMf_UNICODE);
+
+ /* The dual charset means unicode semantics if the
+ * pattern (or target, not known until runtime) are
+ * utf8, or something in the pattern indicates unicode
+ * semantics */
+ cs = (RExC_utf8 || RExC_uni_semantics)
+ ? REGEX_UNICODE_CHARSET
+ : REGEX_DEPENDS_CHARSET;
has_charset_modifier = 1;
break;
case ONCE_PAT_MOD: /* 'o' */
}
break;
case '-':
- /* A flag is a default iff it is following a minus, so
+ /* A flag is a default iff it is following a minus, so
* if there is a minus, it means will be trying to
* re-specify a default which is an error */
if (has_use_defaults || flagsp == &negflags) {
case ')':
RExC_flags |= posflags;
RExC_flags &= ~negflags;
+ set_regex_charset(&RExC_flags, cs);
if (paren != ':') {
oregflags |= posflags;
oregflags &= ~negflags;
+ set_regex_charset(&oregflags, cs);
}
nextchar(pRExC_state);
if (paren != ':') {
FAIL("Junk on end of regexp"); /* "Can't happen". */
/* NOTREACHED */
}
+
+ if (RExC_in_lookbehind) {
+ RExC_in_lookbehind--;
+ }
if (after_freeze)
RExC_npar = after_freeze;
return(ret);
char *endchar; /* Points to '.' or '}' ending cur char in the input
stream */
- ret = reg_node(pRExC_state,
- (U8)(FOLD ? (LOC ? EXACTFL : EXACTF) : EXACT));
+ ret = reg_node(pRExC_state, (U8) ((! FOLD) ? EXACT
+ : (LOC)
+ ? EXACTFL
+ : UNI_SEMANTICS
+ ? EXACTFU
+ : EXACTF));
s= STRING(ret);
/* Exact nodes can hold only a U8 length's of text = 255. Loop through
Note: we have to be careful with escapes, as they can be both literal
and special, and in the case of \10 and friends can either, depending
- on context. Specifically there are two seperate switches for handling
+ on context. Specifically there are two separate switches for handling
escape sequences, with the one for handling literal escapes requiring
a dummy entry for all of the special escapes that are actually handled
by the other.
register regnode *ret = NULL;
I32 flags;
char *parse_start = RExC_parse;
+ U8 op;
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_PARSE("atom");
*flagp = WORST; /* Tentatively. */
RExC_parse++;
vFAIL("Quantifier follows nothing");
break;
- case 0xDF:
- case 0xC3:
- case 0xCE:
+ case LATIN_SMALL_LETTER_SHARP_S:
+ case UTF8_TWO_BYTE_HI_nocast(LATIN_SMALL_LETTER_SHARP_S):
+ case UTF8_TWO_BYTE_HI_nocast(IOTA_D_T):
+#if UTF8_TWO_BYTE_HI_nocast(UPSILON_D_T) != UTF8_TWO_BYTE_HI_nocast(IOTA_D_T)
+#error The beginning utf8 byte of IOTA_D_T and UPSILON_D_T unexpectedly differ. Other instances in this code should have the case statement below.
+ case UTF8_TWO_BYTE_HI_nocast(UPSILON_D_T):
+#endif
do_foldchar:
if (!LOC && FOLD) {
U32 len,cp;
literal text handling code.
*/
switch ((U8)*++RExC_parse) {
- case 0xDF:
- case 0xC3:
- case 0xCE:
+ case LATIN_SMALL_LETTER_SHARP_S:
+ case UTF8_TWO_BYTE_HI_nocast(LATIN_SMALL_LETTER_SHARP_S):
+ case UTF8_TWO_BYTE_HI_nocast(IOTA_D_T):
goto do_foldchar;
/* Special Escapes */
case 'A':
*flagp |= HASWIDTH;
goto finish_meta_pat;
case 'w':
- ret = reg_node(pRExC_state, (U8)(LOC ? ALNUML : ALNUM));
+ switch (get_regex_charset(RExC_flags)) {
+ case REGEX_LOCALE_CHARSET:
+ op = ALNUML;
+ break;
+ case REGEX_UNICODE_CHARSET:
+ op = ALNUMU;
+ break;
+ case REGEX_ASCII_RESTRICTED_CHARSET:
+ op = ALNUMA;
+ break;
+ case REGEX_DEPENDS_CHARSET:
+ op = ALNUM;
+ break;
+ default:
+ goto bad_charset;
+ }
+ ret = reg_node(pRExC_state, op);
*flagp |= HASWIDTH|SIMPLE;
goto finish_meta_pat;
case 'W':
- ret = reg_node(pRExC_state, (U8)(LOC ? NALNUML : NALNUM));
+ switch (get_regex_charset(RExC_flags)) {
+ case REGEX_LOCALE_CHARSET:
+ op = NALNUML;
+ break;
+ case REGEX_UNICODE_CHARSET:
+ op = NALNUMU;
+ break;
+ case REGEX_ASCII_RESTRICTED_CHARSET:
+ op = NALNUMA;
+ break;
+ case REGEX_DEPENDS_CHARSET:
+ op = NALNUM;
+ break;
+ default:
+ goto bad_charset;
+ }
+ ret = reg_node(pRExC_state, op);
*flagp |= HASWIDTH|SIMPLE;
goto finish_meta_pat;
case 'b':
RExC_seen_zerolen++;
RExC_seen |= REG_SEEN_LOOKBEHIND;
- ret = reg_node(pRExC_state, (U8)(LOC ? BOUNDL : BOUND));
+ switch (get_regex_charset(RExC_flags)) {
+ case REGEX_LOCALE_CHARSET:
+ op = BOUNDL;
+ break;
+ case REGEX_UNICODE_CHARSET:
+ op = BOUNDU;
+ break;
+ case REGEX_ASCII_RESTRICTED_CHARSET:
+ op = BOUNDA;
+ break;
+ case REGEX_DEPENDS_CHARSET:
+ op = BOUND;
+ break;
+ default:
+ goto bad_charset;
+ }
+ ret = reg_node(pRExC_state, op);
+ FLAGS(ret) = get_regex_charset(RExC_flags);
*flagp |= SIMPLE;
goto finish_meta_pat;
case 'B':
RExC_seen_zerolen++;
RExC_seen |= REG_SEEN_LOOKBEHIND;
- ret = reg_node(pRExC_state, (U8)(LOC ? NBOUNDL : NBOUND));
+ switch (get_regex_charset(RExC_flags)) {
+ case REGEX_LOCALE_CHARSET:
+ op = NBOUNDL;
+ break;
+ case REGEX_UNICODE_CHARSET:
+ op = NBOUNDU;
+ break;
+ case REGEX_ASCII_RESTRICTED_CHARSET:
+ op = NBOUNDA;
+ break;
+ case REGEX_DEPENDS_CHARSET:
+ op = NBOUND;
+ break;
+ default:
+ goto bad_charset;
+ }
+ ret = reg_node(pRExC_state, op);
+ FLAGS(ret) = get_regex_charset(RExC_flags);
*flagp |= SIMPLE;
goto finish_meta_pat;
case 's':
- ret = reg_node(pRExC_state, (U8)(LOC ? SPACEL : SPACE));
+ switch (get_regex_charset(RExC_flags)) {
+ case REGEX_LOCALE_CHARSET:
+ op = SPACEL;
+ break;
+ case REGEX_UNICODE_CHARSET:
+ op = SPACEU;
+ break;
+ case REGEX_ASCII_RESTRICTED_CHARSET:
+ op = SPACEA;
+ break;
+ case REGEX_DEPENDS_CHARSET:
+ op = SPACE;
+ break;
+ default:
+ goto bad_charset;
+ }
+ ret = reg_node(pRExC_state, op);
*flagp |= HASWIDTH|SIMPLE;
goto finish_meta_pat;
case 'S':
- ret = reg_node(pRExC_state, (U8)(LOC ? NSPACEL : NSPACE));
+ switch (get_regex_charset(RExC_flags)) {
+ case REGEX_LOCALE_CHARSET:
+ op = NSPACEL;
+ break;
+ case REGEX_UNICODE_CHARSET:
+ op = NSPACEU;
+ break;
+ case REGEX_ASCII_RESTRICTED_CHARSET:
+ op = NSPACEA;
+ break;
+ case REGEX_DEPENDS_CHARSET:
+ op = NSPACE;
+ break;
+ default:
+ goto bad_charset;
+ }
+ ret = reg_node(pRExC_state, op);
*flagp |= HASWIDTH|SIMPLE;
goto finish_meta_pat;
case 'd':
- ret = reg_node(pRExC_state, DIGIT);
+ switch (get_regex_charset(RExC_flags)) {
+ case REGEX_LOCALE_CHARSET:
+ op = DIGITL;
+ break;
+ case REGEX_ASCII_RESTRICTED_CHARSET:
+ op = DIGITA;
+ break;
+ case REGEX_DEPENDS_CHARSET: /* No difference between these */
+ case REGEX_UNICODE_CHARSET:
+ op = DIGIT;
+ break;
+ default:
+ goto bad_charset;
+ }
+ ret = reg_node(pRExC_state, op);
*flagp |= HASWIDTH|SIMPLE;
goto finish_meta_pat;
case 'D':
- ret = reg_node(pRExC_state, NDIGIT);
+ switch (get_regex_charset(RExC_flags)) {
+ case REGEX_LOCALE_CHARSET:
+ op = NDIGITL;
+ break;
+ case REGEX_ASCII_RESTRICTED_CHARSET:
+ op = NDIGITA;
+ break;
+ case REGEX_DEPENDS_CHARSET: /* No difference between these */
+ case REGEX_UNICODE_CHARSET:
+ op = NDIGIT;
+ break;
+ default:
+ goto bad_charset;
+ }
+ ret = reg_node(pRExC_state, op);
*flagp |= HASWIDTH|SIMPLE;
goto finish_meta_pat;
case 'R':
RExC_sawback = 1;
ret = reganode(pRExC_state,
- (U8)(FOLD ? (LOC ? NREFFL : NREFF) : NREF),
- num);
+ ((! FOLD)
+ ? NREF
+ : (AT_LEAST_UNI_SEMANTICS)
+ ? NREFFU
+ : (LOC)
+ ? NREFFL
+ : NREFF),
+ num);
*flagp |= HASWIDTH;
/* override incorrect value set in reganode MJD */
}
RExC_sawback = 1;
ret = reganode(pRExC_state,
- (U8)(FOLD ? (LOC ? REFFL : REFF) : REF),
- num);
+ ((! FOLD)
+ ? REF
+ : (AT_LEAST_UNI_SEMANTICS)
+ ? REFFU
+ : (LOC)
+ ? REFFL
+ : REFF),
+ num);
*flagp |= HASWIDTH;
/* override incorrect value set in reganode MJD */
defchar:
ender = 0;
ret = reg_node(pRExC_state,
- (U8)(FOLD ? (LOC ? EXACTFL : EXACTF) : EXACT));
+ (U8) ((! FOLD) ? EXACT
+ : (LOC)
+ ? EXACTFL
+ : (AT_LEAST_UNI_SEMANTICS)
+ ? EXACTFU
+ : EXACTF)
+ );
s = STRING(ret);
for (len = 0, p = RExC_parse - 1;
len < 127 && p < RExC_end;
if (RExC_flags & RXf_PMf_EXTENDED)
p = regwhite( pRExC_state, p );
switch ((U8)*p) {
- case 0xDF:
- case 0xC3:
- case 0xCE:
+ case LATIN_SMALL_LETTER_SHARP_S:
+ case UTF8_TWO_BYTE_HI_nocast(LATIN_SMALL_LETTER_SHARP_S):
+ case UTF8_TWO_BYTE_HI_nocast(IOTA_D_T):
if (LOC || !FOLD || !is_TRICKYFOLD_safe(p,RExC_end,UTF))
goto normal_default;
case '^':
switch ((U8)*++p) {
/* These are all the special escapes. */
- case 0xDF:
- case 0xC3:
- case 0xCE:
+ case LATIN_SMALL_LETTER_SHARP_S:
+ case UTF8_TWO_BYTE_HI_nocast(LATIN_SMALL_LETTER_SHARP_S):
+ case UTF8_TWO_BYTE_HI_nocast(IOTA_D_T):
if (LOC || !FOLD || !is_TRICKYFOLD_safe(p,RExC_end,UTF))
goto normal_default;
case 'A': /* Start assertion */
}
return(ret);
+
+/* Jumped to when an unrecognized character set is encountered */
+bad_charset:
+ Perl_croak(aTHX_ "panic: Unknown regex character set encoding: %u", get_regex_charset(RExC_flags));
+ return(NULL);
}
STATIC char *
}
}
-
-#define _C_C_T_(NAME,TEST,WORD) \
-ANYOF_##NAME: \
- if (LOC) \
- ANYOF_CLASS_SET(ret, ANYOF_##NAME); \
- else { \
- for (value = 0; value < 256; value++) \
- if (TEST) \
- ANYOF_BITMAP_SET(ret, value); \
- } \
- yesno = '+'; \
- what = WORD; \
- break; \
-case ANYOF_N##NAME: \
- if (LOC) \
- ANYOF_CLASS_SET(ret, ANYOF_N##NAME); \
- else { \
- for (value = 0; value < 256; value++) \
- if (!TEST) \
- ANYOF_BITMAP_SET(ret, value); \
- } \
- yesno = '!'; \
- what = WORD; \
+/* No locale test, and always Unicode semantics */
+#define _C_C_T_NOLOC_(NAME,TEST,WORD) \
+ANYOF_##NAME: \
+ for (value = 0; value < 256; value++) \
+ if (TEST) \
+ stored += S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) value, &nonbitmap); \
+ yesno = '+'; \
+ what = WORD; \
+ break; \
+case ANYOF_N##NAME: \
+ for (value = 0; value < 256; value++) \
+ if (!TEST) \
+ stored += S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) value, &nonbitmap); \
+ yesno = '!'; \
+ what = WORD; \
break
-#define _C_C_T_NOLOC_(NAME,TEST,WORD) \
-ANYOF_##NAME: \
- for (value = 0; value < 256; value++) \
- if (TEST) \
- ANYOF_BITMAP_SET(ret, value); \
- yesno = '+'; \
- what = WORD; \
- break; \
-case ANYOF_N##NAME: \
- for (value = 0; value < 256; value++) \
- if (!TEST) \
- ANYOF_BITMAP_SET(ret, value); \
- yesno = '!'; \
- what = WORD; \
+/* Like the above, but there are differences if we are in uni-8-bit or not, so
+ * there are two tests passed in, to use depending on that. There aren't any
+ * cases where the label is different from the name, so no need for that
+ * parameter */
+#define _C_C_T_(NAME, TEST_8, TEST_7, WORD) \
+ANYOF_##NAME: \
+ if (LOC) ANYOF_CLASS_SET(ret, ANYOF_##NAME); \
+ else if (UNI_SEMANTICS) { \
+ for (value = 0; value < 256; value++) { \
+ if (TEST_8(value)) stored += \
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) value, &nonbitmap); \
+ } \
+ } \
+ else { \
+ for (value = 0; value < 128; value++) { \
+ if (TEST_7(UNI_TO_NATIVE(value))) stored += \
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, \
+ (U8) UNI_TO_NATIVE(value), &nonbitmap); \
+ } \
+ } \
+ yesno = '+'; \
+ what = WORD; \
+ break; \
+case ANYOF_N##NAME: \
+ if (LOC) ANYOF_CLASS_SET(ret, ANYOF_N##NAME); \
+ else if (UNI_SEMANTICS) { \
+ for (value = 0; value < 256; value++) { \
+ if (! TEST_8(value)) stored += \
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) value, &nonbitmap); \
+ } \
+ } \
+ else { \
+ for (value = 0; value < 128; value++) { \
+ if (! TEST_7(UNI_TO_NATIVE(value))) stored += S_set_regclass_bit( \
+ aTHX_ pRExC_state, ret, (U8) UNI_TO_NATIVE(value), &nonbitmap); \
+ } \
+ if (ASCII_RESTRICTED) { \
+ for (value = 128; value < 256; value++) { \
+ stored += S_set_regclass_bit( \
+ aTHX_ pRExC_state, ret, (U8) UNI_TO_NATIVE(value), &nonbitmap); \
+ } \
+ ANYOF_FLAGS(ret) |= ANYOF_UNICODE_ALL|ANYOF_UTF8; \
+ } \
+ else { \
+ /* For a non-ut8 target string with DEPENDS semantics, all above \
+ * ASCII Latin1 code points match the complement of any of the \
+ * classes. But in utf8, they have their Unicode semantics, so \
+ * can't just set them in the bitmap, or else regexec.c will think \
+ * they matched when they shouldn't. */ \
+ ANYOF_FLAGS(ret) |= ANYOF_NON_UTF8_LATIN1_ALL|ANYOF_UTF8; \
+ } \
+ } \
+ yesno = '!'; \
+ what = WORD; \
break
/*
#define POSIX_CC_UNI_NAME(CCNAME) "Posix" CCNAME
#endif
+STATIC U8
+S_set_regclass_bit_fold(pTHX_ RExC_state_t *pRExC_state, regnode* node, const U8 value, HV** nonbitmap_ptr)
+{
+
+ /* Handle the setting of folds in the bitmap for non-locale ANYOF nodes.
+ * Locale folding is done at run-time, so this function should not be
+ * called for nodes that are for locales.
+ *
+ * This function simply sets the bit corresponding to the fold of the input
+ * 'value', if not already set. The fold of 'f' is 'F', and the fold of
+ * 'F' is 'f'.
+ *
+ * It also sets any necessary flags, and returns the number of bits that
+ * actually changed from 0 to 1 */
+
+ U8 stored = 0;
+ U8 fold;
+
+ fold = (AT_LEAST_UNI_SEMANTICS) ? PL_fold_latin1[value]
+ : PL_fold[value];
+
+ /* It assumes the bit for 'value' has already been set */
+ if (fold != value && ! ANYOF_BITMAP_TEST(node, fold)) {
+ ANYOF_BITMAP_SET(node, fold);
+ stored++;
+ }
+ if (_HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(value)
+ || (! UNI_SEMANTICS
+ && ! isASCII(value)
+ && PL_fold_latin1[value] != value))
+ { /* A character that has a fold outside of Latin1 matches outside the
+ bitmap, but only when the target string is utf8. Similarly when we
+ don't have unicode semantics for the above ASCII Latin-1 characters,
+ and they have a fold, they should match if the target is utf8, and
+ not otherwise */
+ if (! *nonbitmap_ptr) {
+ *nonbitmap_ptr = _new_invlist(2);
+ }
+ *nonbitmap_ptr = add_range_to_invlist(*nonbitmap_ptr, value, value);
+ ANYOF_FLAGS(node) |= ANYOF_UTF8;
+ }
+
+ return stored;
+}
+
+
+PERL_STATIC_INLINE U8
+S_set_regclass_bit(pTHX_ RExC_state_t *pRExC_state, regnode* node, const U8 value, HV** nonbitmap_ptr)
+{
+ /* This inline function sets a bit in the bitmap if not already set, and if
+ * appropriate, its fold, returning the number of bits that actually
+ * changed from 0 to 1 */
+
+ U8 stored;
+
+ if (ANYOF_BITMAP_TEST(node, value)) { /* Already set */
+ return 0;
+ }
+
+ ANYOF_BITMAP_SET(node, value);
+ stored = 1;
+
+ if (FOLD && ! LOC) { /* Locale folds aren't known until runtime */
+ stored += S_set_regclass_bit_fold(aTHX_ pRExC_state, node, value, nonbitmap_ptr);
+ }
+
+ return stored;
+}
+
/*
parse a class specification and produce either an ANYOF node that
matches the pattern or if the pattern matches a single char only and
bool need_class = 0;
SV *listsv = NULL;
UV n;
- bool optimize_invert = TRUE;
+ HV* nonbitmap = NULL;
AV* unicode_alternate = NULL;
#ifdef EBCDIC
UV literal_endpoint = 0;
#endif
- UV stored = 0; /* number of chars stored in the class */
+ UV stored = 0; /* how many chars stored in the bitmap */
regnode * const orig_emit = RExC_emit; /* Save the original RExC_emit in
case we need to change the emitted regop to an EXACT. */
/* Assume we are going to generate an ANYOF node. */
ret = reganode(pRExC_state, ANYOF, 0);
- if (!SIZE_ONLY)
+
+ if (!SIZE_ONLY) {
ANYOF_FLAGS(ret) = 0;
+ }
if (UCHARAT(RExC_parse) == '^') { /* Complement of range. */
RExC_naughty++;
if (SIZE_ONLY) {
RExC_size += ANYOF_SKIP;
+#ifdef ANYOF_ADD_LOC_SKIP
+ if (LOC) {
+ RExC_size += ANYOF_ADD_LOC_SKIP;
+ }
+#endif
listsv = &PL_sv_undef; /* For code scanners: listsv always non-NULL. */
}
else {
RExC_emit += ANYOF_SKIP;
- if (FOLD)
- ANYOF_FLAGS(ret) |= ANYOF_FOLD;
- if (LOC)
+ if (LOC) {
ANYOF_FLAGS(ret) |= ANYOF_LOCALE;
+#ifdef ANYOF_ADD_LOC_SKIP
+ RExC_emit += ANYOF_ADD_LOC_SKIP;
+#endif
+ }
ANYOF_BITMAP_ZERO(ret);
listsv = newSVpvs("# comment\n");
}
e = RExC_parse;
n = 1;
}
- if (!SIZE_ONLY) {
+ if (SIZE_ONLY) {
+ if (LOC) {
+ ckWARN2reg(RExC_parse,
+ "\\%c uses Unicode rules, not locale rules",
+ (int) value);
+ }
+ }
+ else {
if (UCHARAT(RExC_parse) == '^') {
RExC_parse++;
n--;
n--;
}
}
- Perl_sv_catpvf(aTHX_ listsv, "%cutf8::%.*s\n",
- (value=='p' ? '+' : '!'), (int)n, RExC_parse);
+
+ /* Add the property name to the list. If /i matching, give
+ * a different name which consists of the normal name
+ * sandwiched between two underscores and '_i'. The design
+ * is discussed in the commit message for this. */
+ Perl_sv_catpvf(aTHX_ listsv, "%cutf8::%s%.*s%s\n",
+ (value=='p' ? '+' : '!'),
+ (FOLD) ? "__" : "",
+ (int)n,
+ RExC_parse,
+ (FOLD) ? "_i" : ""
+ );
}
RExC_parse = e + 1;
- ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
+
+ /* The \p could match something in the Latin1 range, hence
+ * something that isn't utf8 */
+ ANYOF_FLAGS(ret) |= ANYOF_NONBITMAP;
namedclass = ANYOF_MAX; /* no official name, but it's named */
+
+ /* \p means they want Unicode semantics */
+ RExC_uni_semantics = 1;
}
break;
case 'n': value = '\n'; break;
if (namedclass > OOB_NAMEDCLASS) { /* this is a named class \blah */
- if (!SIZE_ONLY && !need_class)
- ANYOF_CLASS_ZERO(ret);
-
- need_class = 1;
+ /* What matches in a locale is not known until runtime, so need to
+ * (one time per class) allocate extra space to pass to regexec.
+ * The 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 && namedclass < ANYOF_MAX && ! need_class) {
+ need_class = 1;
+ if (SIZE_ONLY) {
+#ifdef ANYOF_CLASS_ADD_SKIP
+ RExC_size += ANYOF_CLASS_ADD_SKIP;
+#endif
+ }
+ else {
+#ifdef ANYOF_CLASS_ADD_SKIP
+ RExC_emit += ANYOF_CLASS_ADD_SKIP;
+#endif
+ ANYOF_CLASS_ZERO(ret);
+ }
+ ANYOF_FLAGS(ret) |= ANYOF_CLASS;
+ }
- /* a bad range like a-\d, a-[:digit:] ? */
+ /* a bad range like a-\d, a-[:digit:]. The '-' is taken as a
+ * literal */
if (range) {
if (!SIZE_ONLY) {
const int w =
w, w, rangebegin);
if (prevvalue < 256) {
- ANYOF_BITMAP_SET(ret, prevvalue);
- ANYOF_BITMAP_SET(ret, '-');
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) prevvalue, &nonbitmap);
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, '-', &nonbitmap);
}
else {
- ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
+ ANYOF_FLAGS(ret) |= ANYOF_UTF8;
Perl_sv_catpvf(aTHX_ listsv,
- "%04"UVxf"\n%04"UVxf"\n", (UV)prevvalue, (UV) '-');
+ "%04"UVxf"\n%04"UVxf"\n", (UV)prevvalue, (UV) '-');
}
}
const char *what = NULL;
char yesno = 0;
- if (namedclass > OOB_NAMEDCLASS)
- optimize_invert = FALSE;
/* Possible truncation here but in some 64-bit environments
* the compiler gets heartburn about switch on 64-bit values.
* A similar issue a little earlier when switching on value.
* --jhi */
switch ((I32)namedclass) {
- case _C_C_T_(ALNUMC, isALNUMC(value), POSIX_CC_UNI_NAME("Alnum"));
- case _C_C_T_(ALPHA, isALPHA(value), POSIX_CC_UNI_NAME("Alpha"));
- case _C_C_T_(BLANK, isBLANK(value), POSIX_CC_UNI_NAME("Blank"));
- case _C_C_T_(CNTRL, isCNTRL(value), POSIX_CC_UNI_NAME("Cntrl"));
- case _C_C_T_(GRAPH, isGRAPH(value), POSIX_CC_UNI_NAME("Graph"));
- case _C_C_T_(LOWER, isLOWER(value), POSIX_CC_UNI_NAME("Lower"));
- case _C_C_T_(PRINT, isPRINT(value), POSIX_CC_UNI_NAME("Print"));
- case _C_C_T_(PSXSPC, isPSXSPC(value), POSIX_CC_UNI_NAME("Space"));
- case _C_C_T_(PUNCT, isPUNCT(value), POSIX_CC_UNI_NAME("Punct"));
- case _C_C_T_(UPPER, isUPPER(value), POSIX_CC_UNI_NAME("Upper"));
+ case _C_C_T_(ALNUMC, isALNUMC_L1, isALNUMC, "XPosixAlnum");
+ case _C_C_T_(ALPHA, isALPHA_L1, isALPHA, "XPosixAlpha");
+ case _C_C_T_(BLANK, isBLANK_L1, isBLANK, "XPosixBlank");
+ case _C_C_T_(CNTRL, isCNTRL_L1, isCNTRL, "XPosixCntrl");
+ case _C_C_T_(GRAPH, isGRAPH_L1, isGRAPH, "XPosixGraph");
+ case _C_C_T_(LOWER, isLOWER_L1, isLOWER, "XPosixLower");
+ case _C_C_T_(PRINT, isPRINT_L1, isPRINT, "XPosixPrint");
+ case _C_C_T_(PSXSPC, isPSXSPC_L1, isPSXSPC, "XPosixSpace");
+ case _C_C_T_(PUNCT, isPUNCT_L1, isPUNCT, "XPosixPunct");
+ case _C_C_T_(UPPER, isUPPER_L1, isUPPER, "XPosixUpper");
#ifdef BROKEN_UNICODE_CHARCLASS_MAPPINGS
- case _C_C_T_(ALNUM, isALNUM(value), "Word");
- case _C_C_T_(SPACE, isSPACE(value), "SpacePerl");
+ /* \s, \w match all unicode if utf8. */
+ case _C_C_T_(SPACE, isSPACE_L1, isSPACE, "SpacePerl");
+ case _C_C_T_(ALNUM, isWORDCHAR_L1, isALNUM, "Word");
#else
- case _C_C_T_(SPACE, isSPACE(value), "PerlSpace");
- case _C_C_T_(ALNUM, isALNUM(value), "PerlWord");
+ /* \s, \w match ascii and locale only */
+ case _C_C_T_(SPACE, isSPACE_L1, isSPACE, "PerlSpace");
+ case _C_C_T_(ALNUM, isWORDCHAR_L1, isALNUM, "PerlWord");
#endif
- case _C_C_T_(XDIGIT, isXDIGIT(value), "XDigit");
+ case _C_C_T_(XDIGIT, isXDIGIT_L1, isXDIGIT, "XPosixXDigit");
case _C_C_T_NOLOC_(VERTWS, is_VERTWS_latin1(&value), "VertSpace");
case _C_C_T_NOLOC_(HORIZWS, is_HORIZWS_latin1(&value), "HorizSpace");
case ANYOF_ASCII:
if (LOC)
ANYOF_CLASS_SET(ret, ANYOF_ASCII);
else {
-#ifndef EBCDIC
for (value = 0; value < 128; value++)
- ANYOF_BITMAP_SET(ret, value);
-#else /* EBCDIC */
- for (value = 0; value < 256; value++) {
- if (isASCII(value))
- ANYOF_BITMAP_SET(ret, value);
- }
-#endif /* EBCDIC */
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) ASCII_TO_NATIVE(value), &nonbitmap);
}
yesno = '+';
- what = "ASCII";
+ what = NULL; /* Doesn't match outside ascii, so
+ don't want to add +utf8:: */
break;
case ANYOF_NASCII:
if (LOC)
ANYOF_CLASS_SET(ret, ANYOF_NASCII);
else {
-#ifndef EBCDIC
for (value = 128; value < 256; value++)
- ANYOF_BITMAP_SET(ret, value);
-#else /* EBCDIC */
- for (value = 0; value < 256; value++) {
- if (!isASCII(value))
- ANYOF_BITMAP_SET(ret, value);
- }
-#endif /* EBCDIC */
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) ASCII_TO_NATIVE(value), &nonbitmap);
}
+ ANYOF_FLAGS(ret) |= ANYOF_UNICODE_ALL;
yesno = '!';
what = "ASCII";
break;
else {
/* consecutive digits assumed */
for (value = '0'; value <= '9'; value++)
- ANYOF_BITMAP_SET(ret, value);
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) value, &nonbitmap);
}
yesno = '+';
what = POSIX_CC_UNI_NAME("Digit");
else {
/* consecutive digits assumed */
for (value = 0; value < '0'; value++)
- ANYOF_BITMAP_SET(ret, value);
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) value, &nonbitmap);
for (value = '9' + 1; value < 256; value++)
- ANYOF_BITMAP_SET(ret, value);
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) value, &nonbitmap);
}
yesno = '!';
what = POSIX_CC_UNI_NAME("Digit");
+ if (ASCII_RESTRICTED ) {
+ ANYOF_FLAGS(ret) |= ANYOF_UNICODE_ALL;
+ }
break;
case ANYOF_MAX:
/* this is to handle \p and \P */
vFAIL("Invalid [::] class");
break;
}
- if (what) {
+ if (what && ! (ASCII_RESTRICTED)) {
/* Strings such as "+utf8::isWord\n" */
Perl_sv_catpvf(aTHX_ listsv, "%cutf8::Is%s\n", yesno, what);
+ ANYOF_FLAGS(ret) |= ANYOF_UTF8;
}
- if (LOC)
- ANYOF_FLAGS(ret) |= ANYOF_CLASS;
+
continue;
}
} /* end of namedclass \blah */
w, w, rangebegin);
}
if (!SIZE_ONLY)
- ANYOF_BITMAP_SET(ret, '-');
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, '-', &nonbitmap);
} else
range = 1; /* yeah, it's a range! */
continue; /* but do it the next time */
}
}
+ if (value > 255) {
+ RExC_uni_semantics = 1;
+ }
+
/* now is the next time */
- /*stored += (value - prevvalue + 1);*/
if (!SIZE_ONLY) {
if (prevvalue < 256) {
const IV ceilvalue = value < 256 ? value : 255;
if (isLOWER(prevvalue)) {
for (i = prevvalue; i <= ceilvalue; i++)
if (isLOWER(i) && !ANYOF_BITMAP_TEST(ret,i)) {
- stored++;
- ANYOF_BITMAP_SET(ret, i);
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) i, &nonbitmap);
}
} else {
for (i = prevvalue; i <= ceilvalue; i++)
if (isUPPER(i) && !ANYOF_BITMAP_TEST(ret,i)) {
- stored++;
- ANYOF_BITMAP_SET(ret, i);
+ stored +=
+ S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) i, &nonbitmap);
}
}
}
else
#endif
for (i = prevvalue; i <= ceilvalue; i++) {
- if (!ANYOF_BITMAP_TEST(ret,i)) {
- stored++;
- ANYOF_BITMAP_SET(ret, i);
- }
+ stored += S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) i, &nonbitmap);
}
}
- if (value > 255 || UTF) {
- const UV prevnatvalue = NATIVE_TO_UNI(prevvalue);
- const UV natvalue = NATIVE_TO_UNI(value);
- stored+=2; /* can't optimize this class */
- ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
- if (prevnatvalue < natvalue) { /* what about > ? */
+ if (value > 255) {
+ const UV prevnatvalue = NATIVE_TO_UNI(prevvalue);
+ const UV natvalue = NATIVE_TO_UNI(value);
+ if (! nonbitmap) {
+ nonbitmap = _new_invlist(2);
+ }
+ nonbitmap = add_range_to_invlist(nonbitmap, prevnatvalue, natvalue);
+ ANYOF_FLAGS(ret) |= ANYOF_UTF8;
+ }
+#if 0
+
+ /* If the code point requires utf8 to represent, and we are not
+ * folding, it can't match unless the target is in utf8. Only
+ * a few code points above 255 fold to below it, so XXX an
+ * optimization would be to know which ones and set the flag
+ * appropriately. */
+ ANYOF_FLAGS(ret) |= (FOLD || value < 256)
+ ? ANYOF_NONBITMAP
+ : ANYOF_UTF8;
+ if (prevnatvalue < natvalue) { /* '>' case is fatal error above */
+
+ /* The \t sets the whole range */
Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n",
prevnatvalue, natvalue);
+
+ /* Currently, we don't look at every value in the range.
+ * Therefore we have to assume the worst case: that if
+ * folding, it will match more than one character. But in
+ * lookbehind patterns, can only be single character
+ * length, so disallow those folds */
+ if (FOLD && ! RExC_in_lookbehind) {
+ OP(ret) = ANYOFV;
+ }
}
else if (prevnatvalue == natvalue) {
Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n", natvalue);
#endif
Perl_sv_catpvf(aTHX_ listsv,
"%04"UVxf"\n", f);
- else {
+ else if (! RExC_in_lookbehind) {
/* Any multicharacter foldings
+ * (disallowed in lookbehind patterns)
* require the following transform:
* [ABCDEF] -> (?:[ABCabcDEFd]|pq|rst)
* where E folds into "pq" and F folds
sv = newSVpvn_utf8((char*)foldbuf, foldlen,
TRUE);
av_push(unicode_alternate, sv);
+ OP(ret) = ANYOFV;
}
}
}
}
}
+#endif
#ifdef EBCDIC
literal_endpoint = 0;
#endif
range = 0; /* this range (if it was one) is done now */
}
- if (need_class) {
- ANYOF_FLAGS(ret) |= ANYOF_LARGE;
- if (SIZE_ONLY)
- RExC_size += ANYOF_CLASS_ADD_SKIP;
- else
- RExC_emit += ANYOF_CLASS_ADD_SKIP;
- }
if (SIZE_ONLY)
return ret;
/****** !SIZE_ONLY AFTER HERE *********/
- if( stored == 1 && (value < 128 || (value < 256 && !UTF))
- && !( ANYOF_FLAGS(ret) & ( ANYOF_FLAGS_ALL ^ ANYOF_FOLD ) )
- ) {
- /* optimize single char class to an EXACT node
- but *only* when its not a UTF/high char */
+ /* Finish up the non-bitmap entries */
+ if (nonbitmap) {
+ UV* nonbitmap_array;
+ UV i;
+
+ /* If folding, we add to the list all characters that could fold to or
+ * from the ones already on the list */
+ if (FOLD) {
+ HV* fold_intersection;
+ UV* fold_list;
+
+ /* This is a list of all the characters that participate in folds
+ * (except marks, etc in multi-char folds */
+ if (! PL_utf8_foldable) {
+ SV* swash = swash_init("utf8", "Cased", &PL_sv_undef, 1, 0);
+ PL_utf8_foldable = _swash_to_invlist(swash);
+ }
+
+ /* This is a hash that for a particular fold gives all characters
+ * that are involved in it */
+ if (! PL_utf8_foldclosures) {
+
+ /* If the folds haven't been read in, call a fold
+ * function to force that */
+ if (! PL_utf8_tofold) {
+ U8 dummy[UTF8_MAXBYTES+1];
+ STRLEN dummy_len;
+ to_utf8_fold((U8*) "A", dummy, &dummy_len);
+ }
+ 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 */
+ fold_intersection = invlist_intersection(PL_utf8_foldable, nonbitmap);
+
+ /* Now look at the foldable characters in this class individually */
+ fold_list = invlist_array(fold_intersection);
+ for (i = 0; i < invlist_len(fold_intersection); i++) {
+ UV j;
+
+ /* The next entry is the beginning of the range that is in the
+ * class */
+ UV start = fold_list[i++];
+
+
+ /* The next entry is the beginning of the next range, which
+ * isn't in the class, so the end of the current range is one
+ * less than that */
+ UV end = fold_list[i] - 1;
+
+ /* Look at every character in the range */
+ for (j = start; j <= end; j++) {
+
+ /* Get its fold */
+ U8 foldbuf[UTF8_MAXBYTES_CASE+1];
+ STRLEN foldlen;
+ const UV f = to_uni_fold(j, foldbuf, &foldlen);
+
+ if (foldlen > (STRLEN)UNISKIP(f)) {
+
+ /* Any multicharacter foldings (disallowed in
+ * lookbehind patterns) require the following
+ * transform: [ABCDEF] -> (?:[ABCabcDEFd]|pq|rst) where
+ * E folds into "pq" and F folds into "rst", all other
+ * characters fold to single characters. We save away
+ * these multicharacter foldings, to be later saved as
+ * part of the additional "s" data. */
+ if (! RExC_in_lookbehind) {
+ /* XXX Discard this fold if any are latin1 and LOC */
+ SV *sv;
+
+ if (!unicode_alternate) {
+ unicode_alternate = newAV();
+ }
+ sv = newSVpvn_utf8((char*)foldbuf, foldlen, TRUE);
+ av_push(unicode_alternate, sv);
+
+ /* This node is variable length */
+ OP(ret) = ANYOFV;
+ ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
+ }
+ }
+ else { /* Single character fold */
+ SV** listp;
+
+ /* Consider "k" =~ /[K]/i. The line above would have
+ * just folded the 'k' to itself, and that isn't going
+ * to match 'K'. So we look through the closure of
+ * everything that folds to 'k'. That will find the
+ * 'K'. Initialize the list, if necessary */
+
+ /* The data structure is a hash with the keys every
+ * character that is folded to, like 'k', and the
+ * values each an array of everything that folds to its
+ * key. e.g. [ 'k', 'K', KELVIN_SIGN ] */
+ 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);
+
+ if (c < 256 && AT_LEAST_UNI_SEMANTICS) {
+ stored += S_set_regclass_bit(aTHX_ pRExC_state, ret, (U8) c, &nonbitmap);
+ }
+ /* It may be that the code point is already
+ * in this range or already in the bitmap,
+ * XXX THink about LOC
+ * in which case we need do nothing */
+ else if ((c < start || c > end)
+ && (c > 255
+ || ! ANYOF_BITMAP_TEST(ret, c)))
+ {
+ nonbitmap = add_range_to_invlist(nonbitmap, c, c);
+ }
+ }
+ }
+ }
+ }
+ }
+ invlist_destroy(fold_intersection);
+ } /* End of processing all the folds */
+
+ /* Here have the full list of items to match that aren't in the
+ * bitmap. Convert to the structure that the rest of the code is
+ * expecting. XXX That rest of the code should convert to this
+ * structure */
+ nonbitmap_array = invlist_array(nonbitmap);
+ for (i = 0; i < invlist_len(nonbitmap); i++) {
+
+ /* The next entry is the beginning of the range that is in the
+ * class */
+ UV start = nonbitmap_array[i++];
+
+ /* The next entry is the beginning of the next range, which isn't
+ * in the class, so the end of the current range is one less than
+ * that */
+ UV end = nonbitmap_array[i] - 1;
+
+ if (start == end) {
+ Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n", start);
+ }
+ else {
+ /* The \t sets the whole range */
+ Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n",
+ /* XXX EBCDIC */
+ start, end);
+ }
+ }
+ invlist_destroy(nonbitmap);
+ }
+
+ /* Optimize inverted simple patterns (e.g. [^a-z]). Note that we haven't
+ * set the FOLD flag yet, so this this does optimize those. It doesn't
+ * optimize locale. Doing so perhaps could be done as long as there is
+ * nothing like \w in it; some thought also would have to be given to the
+ * interaction with above 0x100 chars */
+ if (! LOC && (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) {
+ for (value = 0; value < ANYOF_BITMAP_SIZE; ++value)
+ ANYOF_BITMAP(ret)[value] ^= 0xFF;
+ stored = 256 - stored;
+
+ /* The inversion means that everything above 255 is matched; and at the
+ * same time we clear the invert flag */
+ ANYOF_FLAGS(ret) = ANYOF_UTF8|ANYOF_UNICODE_ALL;
+ }
+
+ if (FOLD) {
+ SV *sv;
+
+ /* This is the one character in the bitmap that needs special handling
+ * under non-locale folding, as it folds to two characters 'ss'. This
+ * happens if it is set and not inverting, or isn't set and are
+ * inverting (disallowed in lookbehind patterns because they can't be
+ * variable length) */
+ if (! LOC
+ && ! RExC_in_lookbehind
+ && (cBOOL(ANYOF_BITMAP_TEST(ret, LATIN_SMALL_LETTER_SHARP_S))
+ ^ cBOOL(ANYOF_FLAGS(ret) & ANYOF_INVERT)))
+ {
+ OP(ret) = ANYOFV; /* Can match more than a single char */
+
+ /* Under Unicode semantics), it can do this when the target string
+ * isn't in utf8 */
+ if (UNI_SEMANTICS) {
+ ANYOF_FLAGS(ret) |= ANYOF_NONBITMAP_NON_UTF8;
+ }
+
+ if (!unicode_alternate) {
+ unicode_alternate = newAV();
+ }
+ sv = newSVpvn_utf8("ss", 2, TRUE);
+ av_push(unicode_alternate, sv);
+ }
+
+ /* Folding in the bitmap is taken care of above, but not for locale
+ * (for which we have to wait to see what folding is in effect at
+ * runtime), and for things not in the bitmap. Set run-time fold flag
+ * for these */
+ if ((LOC || (ANYOF_FLAGS(ret) & ANYOF_NONBITMAP))) {
+ ANYOF_FLAGS(ret) |= ANYOF_LOC_NONBITMAP_FOLD;
+ }
+ }
+
+ /* A single character class can be "optimized" into an EXACTish node.
+ * Note that since we don't currently count how many characters there are
+ * outside the bitmap, we are XXX missing optimization possibilities for
+ * them. This optimization can't happen unless this is a truly single
+ * character class, which means that it can't be an inversion into a
+ * many-character class, and there must be no possibility of there being
+ * things outside the bitmap. 'stored' (only) for locales doesn't include
+ * \w, etc, so have to make a special test that they aren't present
+ *
+ * Similarly A 2-character class of the very special form like [bB] can be
+ * optimized into an EXACTFish node, but only for non-locales, and for
+ * characters which only have the two folds; so things like 'fF' and 'Ii'
+ * wouldn't work because they are part of the fold of 'LATIN SMALL LIGATURE
+ * FI'. */
+ if (! (ANYOF_FLAGS(ret) & (ANYOF_NONBITMAP|ANYOF_INVERT|ANYOF_UNICODE_ALL))
+ && (((stored == 1 && ((! (ANYOF_FLAGS(ret) & ANYOF_LOCALE))
+ || (! ANYOF_CLASS_TEST_ANY_SET(ret)))))
+ || (stored == 2 && ((! (ANYOF_FLAGS(ret) & ANYOF_LOCALE))
+ && (! _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(value))
+ /* If the latest code point has a fold whose
+ * bit is set, it must be the only other one */
+ && ((prevvalue = PL_fold_latin1[value]) != (IV)value)
+ && ANYOF_BITMAP_TEST(ret, prevvalue)))))
+ {
+ /* Note that the information needed to decide to do this optimization
+ * is not currently available until the 2nd pass, and that the actually
+ * used EXACTish node takes less space than the calculated ANYOF node,
+ * and hence the amount of space calculated in the first pass is larger
+ * than actually used, so this optimization doesn't gain us any space.
+ * But an EXACT node is faster than an ANYOF node, and can be combined
+ * with any adjacent EXACT nodes later by the optimizer for further
+ * gains. The speed of executing an EXACTF is similar to an ANYOF
+ * node, so the optimization advantage comes from the ability to join
+ * it to adjacent EXACT nodes */
+
const char * cur_parse= RExC_parse;
+ U8 op;
RExC_emit = (regnode *)orig_emit;
RExC_parse = (char *)orig_parse;
- ret = reg_node(pRExC_state,
- (U8)((ANYOF_FLAGS(ret) & ANYOF_FOLD) ? EXACTF : EXACT));
- RExC_parse = (char *)cur_parse;
- *STRING(ret)= (char)value;
- STR_LEN(ret)= 1;
- RExC_emit += STR_SZ(1);
- SvREFCNT_dec(listsv);
- return ret;
- }
- /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
- if ( /* If the only flag is folding (plus possibly inversion). */
- ((ANYOF_FLAGS(ret) & (ANYOF_FLAGS_ALL ^ ANYOF_INVERT)) == ANYOF_FOLD)
- ) {
- for (value = 0; value < 256; ++value) {
- if (ANYOF_BITMAP_TEST(ret, value)) {
- UV fold = PL_fold[value];
- if (fold != value)
- ANYOF_BITMAP_SET(ret, fold);
+ if (stored == 1) {
+
+ /* A locale node with one point can be folded; all the other cases
+ * with folding will have two points, since we calculate them above
+ */
+ if (ANYOF_FLAGS(ret) & ANYOF_LOC_NONBITMAP_FOLD) {
+ op = EXACTFL;
+ }
+ else {
+ op = EXACT;
}
+ } /* else 2 chars in the bit map: the folds of each other */
+ else if (AT_LEAST_UNI_SEMANTICS || !isASCII(value)) {
+
+ /* To join adjacent nodes, they must be the exact EXACTish type.
+ * Try to use the most likely type, by using EXACTFU if the regex
+ * calls for them, or is required because the character is
+ * non-ASCII */
+ op = EXACTFU;
+ }
+ else { /* Otherwise, more likely to be EXACTF type */
+ op = EXACTF;
}
- ANYOF_FLAGS(ret) &= ~ANYOF_FOLD;
- }
- /* optimize inverted simple patterns (e.g. [^a-z]) */
- if (optimize_invert &&
- /* If the only flag is inversion. */
- (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) {
- for (value = 0; value < ANYOF_BITMAP_SIZE; ++value)
- ANYOF_BITMAP(ret)[value] ^= ANYOF_FLAGS_ALL;
- ANYOF_FLAGS(ret) = ANYOF_UNICODE_ALL;
+ ret = reg_node(pRExC_state, op);
+ RExC_parse = (char *)cur_parse;
+ if (UTF && ! NATIVE_IS_INVARIANT(value)) {
+ *STRING(ret)= UTF8_EIGHT_BIT_HI((U8) value);
+ *(STRING(ret) + 1)= UTF8_EIGHT_BIT_LO((U8) value);
+ STR_LEN(ret)= 2;
+ RExC_emit += STR_SZ(2);
+ }
+ else {
+ *STRING(ret)= (char)value;
+ STR_LEN(ret)= 1;
+ RExC_emit += STR_SZ(1);
+ }
+ SvREFCNT_dec(listsv);
+ return ret;
}
+
{
AV * const av = newAV();
SV *rv;
/* nextchar()
- Advance that parse position, and optionall absorbs
+ Advances the parse position, and optionally absorbs
"whitespace" from the inputstream.
Without /x "whitespace" means (?#...) style comments only,
- Look for optimizable sequences at the same time.
- currently only looks for EXACT chains.
-This is expermental 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.
switch (OP(scan)) {
case EXACT:
case EXACTF:
+ case EXACTFU:
case EXACTFL:
if( exact == PSEUDO )
exact= OP(scan);
{
int bit;
int set=0;
+ regex_charset cs;
for (bit=0; bit<32; bit++) {
if (flags & (1<<bit)) {
+ if ((1<<bit) & RXf_PMf_CHARSET) { /* Output separately, below */
+ continue;
+ }
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);
+ }
+ switch (cs) {
+ case REGEX_UNICODE_CHARSET:
+ PerlIO_printf(Perl_debug_log, "UNICODE");
+ break;
+ case REGEX_LOCALE_CHARSET:
+ PerlIO_printf(Perl_debug_log, "LOCALE");
+ break;
+ case REGEX_ASCII_RESTRICTED_CHARSET:
+ PerlIO_printf(Perl_debug_log, "ASCII-RESTRICTED");
+ break;
+ default:
+ PerlIO_printf(Perl_debug_log, "UNKNOWN CHARACTER SET");
+ break;
+ }
+ }
if (lead) {
if (set)
PerlIO_printf(Perl_debug_log, "\n");
* --jhi */
pv_pretty(sv, STRING(o), STR_LEN(o), 60, PL_colors[0], PL_colors[1],
PERL_PV_ESCAPE_UNI_DETECT |
+ PERL_PV_ESCAPE_NONASCII |
PERL_PV_PRETTY_ELLIPSES |
PERL_PV_PRETTY_LTGT |
PERL_PV_PRETTY_NOCLEAR
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) {
+ if ( k != REF || (OP(o) < NREF)) {
AV *list= MUTABLE_AV(progi->data->data[progi->name_list_idx]);
SV **name= av_fetch(list, ARG(o), 0 );
if (name)
if (flags & ANYOF_LOCALE)
sv_catpvs(sv, "{loc}");
- if (flags & ANYOF_FOLD)
+ if (flags & ANYOF_LOC_NONBITMAP_FOLD)
sv_catpvs(sv, "{i}");
Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]);
if (flags & ANYOF_INVERT)
}
EMIT_ANYOF_TEST_SEPARATOR(do_sep,sv,flags);
- /* output any special charclass tests (used mostly under use locale) */
- if (o->flags & ANYOF_CLASS)
+ /* output any special charclass tests (used entirely under use locale) */
+ if (ANYOF_CLASS_TEST_ANY_SET(o))
for (i = 0; i < (int)(sizeof(anyofs)/sizeof(char*)); i++)
if (ANYOF_CLASS_TEST(o,i)) {
sv_catpv(sv, anyofs[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_UNICODE)
- sv_catpvs(sv, "{unicode}");
- else if (flags & ANYOF_UNICODE_ALL)
+ if (flags & ANYOF_UNICODE_ALL)
sv_catpvs(sv, "{unicode_all}");
+ else if (flags & ANYOF_UTF8)
+ sv_catpvs(sv, "{unicode}");
+ if (flags & ANYOF_NONBITMAP_NON_UTF8)
+ sv_catpvs(sv, "{outside bitmap}");
{
SV *lv;
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 to
+ 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 extensions free is called first.)
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 doesnt actually own any of its data except for
+ lightweight copy doesn't actually own any of its data except for
the starp/end and the actual regexp structure itself.
*/
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 perldoesnt
+ 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.
ones (binary 1111 1111, hexadecimal FF). It is similar, but not
identical, to the ASCII delete (DEL) or rubout control character.
) So the old condition can be simplified to !isPRINT(c) */
- if (!isPRINT(c))
- Perl_sv_catpvf(aTHX_ sv, "\\%o", c);
+ if (!isPRINT(c)) {
+ if (c < 256) {
+ Perl_sv_catpvf(aTHX_ sv, "\\x%02x", c);
+ }
+ else {
+ Perl_sv_catpvf(aTHX_ sv, "\\x{%x}", c);
+ }
+ }
else {
const char string = c;
if (c == '-' || c == ']' || c == '\\' || c == '^')
else if ( op == PLUS || op == STAR) {
DUMPUNTIL(NEXTOPER(node), NEXTOPER(node) + 1);
}
- else if (op == ANYOF) {
+ else if (PL_regkind[(U8)op] == ANYOF) {
/* arglen 1 + class block */
- node += 1 + ((ANYOF_FLAGS(node) & ANYOF_LARGE)
+ node += 1 + ((ANYOF_FLAGS(node) & ANYOF_CLASS)
? ANYOF_CLASS_SKIP : ANYOF_SKIP);
node = NEXTOPER(node);
}
https://perl5.git.perl.org / perl5.git / blobdiff