|= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
else
data->flags &= ~SF_FIX_BEFORE_EOL;
- data->minlen_fixed=minlenp;
+ data->minlen_fixed=minlenp;
data->lookbehind_fixed=0;
}
else { /* *data->longest == data->longest_float */
scan += len; \
len = 0; \
} else { \
- uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
- uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \
+ len = UTF8SKIP(uc);\
+ uvc = to_utf8_fold( uc, foldbuf, &foldlen); \
foldlen -= UNISKIP( uvc ); \
scan = foldbuf + UNISKIP( uvc ); \
} \
#endif
switch (flags) {
+ case EXACT: break;
case EXACTFA:
case EXACTFU: folder = PL_fold_latin1; break;
case EXACTF: folder = PL_fold; break;
case EXACTFL: folder = PL_fold_locale; break;
+ default: Perl_croak( aTHX_ "panic! In trie construction, unknown node type %u", (unsigned) flags );
}
trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
"%*sCompiling trie using list compiler\n",
(int)depth * 2 + 2, ""));
-
+
trie->states = (reg_trie_state *)
PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
sizeof(reg_trie_state) );
-
-
-#define JOIN_EXACT(scan,min,flags) \
+#define JOIN_EXACT(scan,min_change,flags) \
if (PL_regkind[OP(scan)] == EXACT) \
- join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
+ join_exact(pRExC_state,(scan),(min_change),(flags),NULL,depth+1)
STATIC U32
-S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
+S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, IV *min_change, U32 flags,regnode *val, U32 depth) {
/* Merge several consecutive EXACTish nodes into one. */
regnode *n = regnext(scan);
U32 stringok = 1;
#endif
DEBUG_PEEP("join",scan,depth);
- /* Skip NOTHING, merge EXACT*. */
- while (n &&
- ( PL_regkind[OP(n)] == NOTHING ||
- (stringok && (OP(n) == OP(scan))))
+ /* Look through the subsequent nodes in the chain. Skip NOTHING, merge
+ * EXACT ones that are mergeable to the current one. */
+ while (n
+ && (PL_regkind[OP(n)] == NOTHING
+ || (stringok && OP(n) == OP(scan)))
&& NEXT_OFF(n)
- && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
+ && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX)
+ {
if (OP(n) == TAIL || n > next)
stringok = 0;
else if (stringok) {
const unsigned int oldl = STR_LEN(scan);
regnode * const nnext = regnext(n);
+
+ if (oldl + STR_LEN(n) > U8_MAX)
+ break;
DEBUG_PEEP("merg",n,depth);
-
merged++;
- if (oldl + STR_LEN(n) > U8_MAX)
- break;
+
NEXT_OFF(scan) += NEXT_OFF(n);
STR_LEN(scan) += STR_LEN(n);
next = n + NODE_SZ_STR(n);
#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 || OP(scan) == EXACTFA)
- && ( STR_LEN(scan) >= 6 ) )
- {
- /*
- Two problematic code points in Unicode casefolding of EXACT nodes:
-
- U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
- U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
-
- which casefold to
-
- Unicode UTF-8
-
- U+03B9 U+0308 U+0301 0xCE 0xB9 0xCC 0x88 0xCC 0x81
- U+03C5 U+0308 U+0301 0xCF 0x85 0xCC 0x88 0xCC 0x81
-
- This means that in case-insensitive matching (or "loose matching",
- as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
- length of the above casefolded versions) can match a target string
- of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
- This would rather mess up the minimum length computation.
-
- What we'll do is to look for the tail four bytes, and then peek
- at the preceding two bytes to see whether we need to decrease
- the minimum length by four (six minus two).
-
- Thanks to the design of UTF-8, there cannot be false matches:
- A sequence of valid UTF-8 bytes cannot be a subsequence of
- another valid sequence of UTF-8 bytes.
-
- */
- char * const s0 = STRING(scan), *s, *t;
- char * const s1 = s0 + STR_LEN(scan) - 1;
- char * const s2 = s1 - 4;
+ *min_change = 0;
+
+ /* Here, all the adjacent mergeable EXACTish nodes have been merged. We
+ * can now analyze for sequences of problematic code points. (Prior to
+ * this final joining, sequences could have been split over boundaries, and
+ * hence missed). The sequences only happen in folding */
+ if (OP(scan) != EXACT) {
+ char *s, *t;
+ char * s0 = STRING(scan);
+ char * const s_end = s0 + STR_LEN(scan);
+
+ /* First we look at the sequences that can occur only in UTF-8 strings.
+ * The sequences are of length 6 */
+ if (UTF && STR_LEN(scan) >= 6) {
+
+ /* Two problematic code points in Unicode casefolding of EXACT
+ * nodes:
+ *
+ * U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+ * U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
+ *
+ * which casefold to
+ *
+ * Unicode UTF-8
+ *
+ * U+03B9 U+0308 U+0301 0xCE 0xB9 0xCC 0x88 0xCC 0x81
+ * U+03C5 U+0308 U+0301 0xCF 0x85 0xCC 0x88 0xCC 0x81
+ *
+ * This means that in case-insensitive matching (or "loose
+ * matching", as Unicode calls it), an EXACTF of length six (the
+ * UTF-8 encoded byte length of the above casefolded versions) can
+ * match a target string of length two (the byte length of UTF-8
+ * encoded U+0390 or U+03B0). This would rather mess up the
+ * minimum length computation. (there are other code points that
+ * also fold to these two sequences, but the delta is smaller)
+ *
+ * What we'll do is to look for the tail four bytes, and then peek
+ * at the preceding two bytes to see whether we need to decrease
+ * the minimum length by four (six minus two).
+ *
+ * Thanks to the design of UTF-8, there cannot be false matches:
+ * A sequence of valid UTF-8 bytes cannot be a subsequence of
+ * another valid sequence of UTF-8 bytes. */
+
#ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
- const char t0[] = "\xaf\x49\xaf\x42";
-#else
- const char t0[] = "\xcc\x88\xcc\x81";
-#endif
- const char * const t1 = t0 + 3;
-
- for (s = s0 + 2;
- s < s2 && (t = ninstr(s, s1, t0, t1));
- s = t + 4) {
-#ifdef EBCDIC
- if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
- ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
+ const char U390_first_byte = '\xb4';
+ const char U390_2nd_byte = '\x68';
+ const char U3B0_first_byte = '\xb5';
+ const char U3B0_2nd_byte = '\x46';
+ const char tail[] = "\xaf\x49\xaf\x42";
#else
- if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
- ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
+ const char U390_first_byte = '\xce';
+ const char U390_2nd_byte = '\xb9';
+ const char U3B0_first_byte = '\xcf';
+ const char U3B0_2nd_byte = '\x85';
+ const char tail[] = "\xcc\x88\xcc\x81";
#endif
- *min -= 4;
- }
+ const STRLEN tail_len = sizeof(tail) - 1;
+ for (s = s0 + 2; /* +2 is to skip the non-tail */
+ s <= s_end - tail_len
+ && (t = ninstr(s, s_end, tail, tail + tail_len));
+ s = t + tail_len)
+ {
+ if ((t[-1] == U390_2nd_byte && t[-2] == U390_first_byte)
+ || (t[-1] == U3B0_2nd_byte && t[-2] == U3B0_first_byte))
+ {
+ *min_change -= 4;
+ }
+ }
+ }
}
-
+
#ifdef DEBUGGING
- /* Allow dumping */
+ /* Allow dumping but overwriting the collection of skipped
+ * ops and/or strings with fake optimized ops */
n = scan + NODE_SZ_STR(scan);
while (n <= stop) {
- if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
- OP(n) = OPTIMIZED;
- NEXT_OFF(n) = 0;
- }
+ OP(n) = OPTIMIZED;
+ FLAGS(n) = 0;
+ NEXT_OFF(n) = 0;
n++;
}
#endif
fake_study_recurse:
while ( scan && OP(scan) != END && scan < last ){
+ IV min_change = 0;
/* Peephole optimizer: */
DEBUG_STUDYDATA("Peep:", data,depth);
DEBUG_PEEP("Peep",scan,depth);
- JOIN_EXACT(scan,&min,0);
+ JOIN_EXACT(scan,&min_change,0);
/* Follow the next-chain of the current node and optimize
away all the NOTHINGs from it. */
int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
int noff;
regnode *n = scan;
-
+
/* Skip NOTHING and LONGJMP. */
while ((n = regnext(n))
&& ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
next = regnext(scan);
code = OP(scan);
/* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
-
+
if (OP(next) == code || code == IFTHEN) {
/* NOTE - There is similar code to this block below for handling
TRIE nodes on a re-study. If you change stuff here check there
I32 max1 = 0, min1 = I32_MAX, num = 0;
struct regnode_charclass_class accum;
regnode * const startbranch=scan;
-
+
if (flags & SCF_DO_SUBSTR)
SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
if (flags & SCF_DO_STCLASS)
a nested if into a case structure of sorts.
*/
-
+
int made=0;
if (!re_trie_maxbuff) {
re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
if ( last && TRIE_TYPE_IS_SAFE ) {
made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
-#ifdef TRIE_STUDY_OPT
+#ifdef TRIE_STUDY_OPT
if ( ((made == MADE_EXACT_TRIE &&
startbranch == first)
|| ( first_non_open == first )) &&
l = utf8_length(s, s + l);
uc = utf8_to_uvchr(s, NULL);
}
- min += l;
- if (flags & SCF_DO_SUBSTR)
- data->pos_min += l;
+ min += l + min_change;
+ if (min < 0) {
+ min = 0;
+ }
+ delta += abs(min_change);
+ if (flags & SCF_DO_SUBSTR) {
+ data->pos_min += l + min_change;
+ if (data->pos_min < 0) {
+ data->pos_min = 0;
+ }
+ data->pos_delta += abs(min_change);
+ if (min_change) {
+ data->longest = &(data->longest_float);
+ }
+ }
if (flags & SCF_DO_STCLASS_AND) {
/* Check whether it is compatible with what we know already! */
int compat = 1;
* 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]);
+
+ /* All folds except under /iaa that include s, S, and
+ * sharp_s also may include the others */
+ if (OP(scan) != EXACTFA) {
+ if (uc == 's' || uc == 'S') {
+ ANYOF_BITMAP_SET(data->start_class,
+ LATIN_SMALL_LETTER_SHARP_S);
+ }
+ else if (uc == LATIN_SMALL_LETTER_SHARP_S) {
+ ANYOF_BITMAP_SET(data->start_class, 's');
+ ANYOF_BITMAP_SET(data->start_class, 'S');
+ }
+ }
}
}
else if (uc >= 0x100) {
* run-time */
ANYOF_BITMAP_SET(data->start_class,
PL_fold_latin1[uc]);
+
+ /* All folds except under /iaa that include s, S,
+ * and sharp_s also may include the others */
+ if (OP(scan) != EXACTFA) {
+ if (uc == 's' || uc == 'S') {
+ ANYOF_BITMAP_SET(data->start_class,
+ LATIN_SMALL_LETTER_SHARP_S);
+ }
+ else if (uc == LATIN_SMALL_LETTER_SHARP_S) {
+ ANYOF_BITMAP_SET(data->start_class, 's');
+ ANYOF_BITMAP_SET(data->start_class, 'S');
+ }
+ }
}
}
data->start_class->flags &= ~ANYOF_EOS;
break;
CASE_SYNST_FNC(VERTWS);
CASE_SYNST_FNC(HORIZWS);
-
+
}
if (flags & SCF_DO_STCLASS_OR)
cl_and(data->start_class, and_withp);
flags &= ~SCF_DO_SUBSTR;
}
#endif /* old or new */
-#endif /* TRIE_STUDY_OPT */
+#endif /* TRIE_STUDY_OPT */
/* Else: zero-length, ignore. */
scan = regnext(scan);
struct regexp *r;
register regexp_internal *ri;
STRLEN plen;
- char *exp;
+ char* VOL exp;
char* xend;
regnode *scan;
I32 flags;
DEBUG_r(if (!PL_colorset) reginitcolors());
- RExC_utf8 = RExC_orig_utf8 = SvUTF8(pattern);
+ exp = SvPV(pattern, plen);
+
+ if (plen == 0) { /* ignore the utf8ness if the pattern is 0 length */
+ RExC_utf8 = RExC_orig_utf8 = 0;
+ }
+ else {
+ RExC_utf8 = RExC_orig_utf8 = SvUTF8(pattern);
+ }
RExC_uni_semantics = 0;
RExC_contains_locale = 0;
}
if (jump_ret == 0) { /* First time through */
- 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();
-- dmq */
DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log,
"UTF8 mismatch! Converting to utf8 for resizing and compile\n"));
- exp = (char*)Perl_bytes_to_utf8(aTHX_ (U8*)SvPV(pattern, plen), &len);
+ exp = (char*)Perl_bytes_to_utf8(aTHX_
+ (U8*)SvPV_nomg(pattern, plen),
+ &len);
xend = exp + len;
RExC_orig_utf8 = RExC_utf8 = 1;
SAVEFREEPV(exp);
* Clever compilers notice this and complain. --jhi */
REGC((U8)REG_MAGIC, (char*)RExC_emit);
#endif
- DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Starting first pass (sizing)\n"));
+ DEBUG_PARSE_r(
+ PerlIO_printf(Perl_debug_log, "Starting first pass (sizing)\n");
+ RExC_lastnum=0;
+ RExC_lastparse=NULL;
+ );
if (reg(pRExC_state, 0, &flags,1) == NULL) {
RExC_precomp = NULL;
return(NULL);
sawplus = 1;
else
first += regarglen[OP(first)];
-
+
first = NEXTOPER(first);
first_next= regnext(first);
}
else
ri->regstclass = first;
}
-#ifdef TRIE_STCLASS
+#ifdef TRIE_STCLASS
else if (PL_regkind[OP(first)] == TRIE &&
((reg_trie_data *)ri->data->data[ ARG(first) ])->minlen>0)
{
make_trie_failtable(pRExC_state, (regnode *)first, trie_op, 0);
ri->regstclass = trie_op;
}
-#endif
+#endif
else if (REGNODE_SIMPLE(OP(first)))
ri->regstclass = first;
else if (PL_regkind[OP(first)] == BOUND ||
* it happens that c_offset_min has been invalidated, since the
* earlier string may buy us something the later one won't.]
*/
-
+
data.longest_fixed = newSVpvs("");
data.longest_float = newSVpvs("");
data.last_found = newSVpvs("");
&data, -1, NULL, NULL,
SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag,0);
-
+
CHECK_RESTUDY_GOTO;
I32 fake;
struct regnode_charclass_class ch_class;
I32 last_close = 0;
-
+
DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "\nMulti Top Level\n"));
scan = ri->program + 1;
if (!retarray)
return ret;
} else {
- ret = newSVsv(&PL_sv_undef);
+ if (retarray)
+ ret = newSVsv(&PL_sv_undef);
}
if (retarray)
av_push(retarray, ret);
return sv_dat;
}
else {
- Perl_croak(aTHX_ "panic: bad flag in reg_scan_name");
+ Perl_croak(aTHX_ "panic: bad flag %lx in reg_scan_name",
+ (unsigned long) flags);
}
/* NOT REACHED */
}
* The 1th element is the first element beyond that not in the list. In other
* words, the first range is
* invlist[0]..(invlist[1]-1)
- * The other ranges follow. Thus every element that is divisible by two marks
- * the beginning of a range that is in the list, and every element not
+ * The other ranges follow. Thus every element whose index is divisible by two
+ * marks the beginning of a range that is in the list, and every element not
* divisible by two marks the beginning of a range not in the list. A single
* element inversion list that contains the single code point N generally
* consists of two elements
PERL_ARGS_ASSERT_INVLIST_ARRAY;
- /* Must not be empty */
+ /* Must not be empty. If these fail, you probably didn't check for <len>
+ * being non-zero before trying to get the array */
assert(*get_invlist_len_addr(invlist));
assert(*get_invlist_zero_addr(invlist) == 0
|| *get_invlist_zero_addr(invlist) == 1);
PERL_STATIC_INLINE UV
S_invlist_len(pTHX_ SV* const invlist)
{
- /* Returns the current number of elements in the inversion list's array */
+ /* Returns the current number of elements stored in the inversion list's
+ * array */
PERL_ARGS_ASSERT_INVLIST_LEN;
*get_invlist_len_addr(invlist) = len;
+ assert(len <= SvLEN(invlist));
+
SvCUR_set(invlist, TO_INTERNAL_SIZE(len));
/* If the list contains U+0000, that element is part of the header,
* and should not be counted as part of the array. It will contain
* TO_INTERNAL_SIZE(len
* - (*get_invlist_zero_addr(inv_list) ^ 1)));
* But, this is only valid if len is not 0. The consequences of not doing
- * this is that the memory allocation code may think that the 1 more UV
- * is being used than actually is, and so might do an unnecessary grow.
- * That seems worth not bothering to make this the precise amount.
+ * this is that the memory allocation code may think that 1 more UV is
+ * being used than actually is, and so might do an unnecessary grow. That
+ * seems worth not bothering to make this the precise amount.
*
* Note that when inverting, SvCUR shouldn't change */
}
/* 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))
-#define PREV_ELEMENT_IN_INVLIST_SET(i) (! ELEMENT_IN_INVLIST_SET(i))
+#define ELEMENT_RANGE_MATCHES_INVLIST(i) (! ((i) & 1))
+#define PREV_RANGE_MATCHES_INVLIST(i) (! ELEMENT_RANGE_MATCHES_INVLIST(i))
#ifndef PERL_IN_XSUB_RE
void
UV final_element = len - 1;
array = invlist_array(invlist);
if (array[final_element] > start
- || ELEMENT_IN_INVLIST_SET(final_element))
+ || ELEMENT_RANGE_MATCHES_INVLIST(final_element))
{
- Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list");
+ Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%"UVuf", start=%"UVuf", match=%c",
+ array[final_element], start,
+ ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f');
}
/* Here, it is a legal append. If the new range begins with the first
}
else {
/* But if the end is the maximum representable on the machine,
- * just let the range that this would extend have no end */
+ * just let the range that this would extend to have no end */
invlist_set_len(invlist, len - 1);
}
return;
invlist_set_len(invlist, len - 1);
}
}
-#endif
-STATIC void
-S_invlist_union(pTHX_ SV* const a, SV* const b, SV** output)
+STATIC IV
+S_invlist_search(pTHX_ SV* const invlist, const UV cp)
+{
+ /* Searches the inversion list for the entry that contains the input code
+ * point <cp>. If <cp> is not in the list, -1 is returned. Otherwise, the
+ * return value is the index into the list's array of the range that
+ * contains <cp> */
+
+ IV low = 0;
+ IV high = invlist_len(invlist);
+ const UV * const array = invlist_array(invlist);
+
+ PERL_ARGS_ASSERT_INVLIST_SEARCH;
+
+ /* If list is empty or the code point is before the first element, return
+ * failure. */
+ if (high == 0 || cp < array[0]) {
+ return -1;
+ }
+
+ /* Binary search. What we are looking for is <i> such that
+ * array[i] <= cp < array[i+1]
+ * The loop below converges on the i+1. */
+ while (low < high) {
+ IV mid = (low + high) / 2;
+ if (array[mid] <= cp) {
+ low = mid + 1;
+
+ /* We could do this extra test to exit the loop early.
+ if (cp < array[low]) {
+ return mid;
+ }
+ */
+ }
+ else { /* cp < array[mid] */
+ high = mid;
+ }
+ }
+
+ return high - 1;
+}
+
+void
+Perl__invlist_populate_swatch(pTHX_ SV* const invlist, const UV start, const UV end, U8* swatch)
+{
+ /* populates a swatch of a swash the same way swatch_get() does in utf8.c,
+ * but is used when the swash has an inversion list. This makes this much
+ * faster, as it uses a binary search instead of a linear one. This is
+ * intimately tied to that function, and perhaps should be in utf8.c,
+ * except it is intimately tied to inversion lists as well. It assumes
+ * that <swatch> is all 0's on input */
+
+ UV current = start;
+ const IV len = invlist_len(invlist);
+ IV i;
+ const UV * array;
+
+ PERL_ARGS_ASSERT__INVLIST_POPULATE_SWATCH;
+
+ if (len == 0) { /* Empty inversion list */
+ return;
+ }
+
+ array = invlist_array(invlist);
+
+ /* Find which element it is */
+ i = invlist_search(invlist, start);
+
+ /* We populate from <start> to <end> */
+ while (current < end) {
+ UV upper;
+
+ /* The inversion list gives the results for every possible code point
+ * after the first one in the list. Only those ranges whose index is
+ * even are ones that the inversion list matches. For the odd ones,
+ * and if the initial code point is not in the list, we have to skip
+ * forward to the next element */
+ if (i == -1 || ! ELEMENT_RANGE_MATCHES_INVLIST(i)) {
+ i++;
+ if (i >= len) { /* Finished if beyond the end of the array */
+ return;
+ }
+ current = array[i];
+ if (current >= end) { /* Finished if beyond the end of what we
+ are populating */
+ return;
+ }
+ }
+ assert(current >= start);
+
+ /* The current range ends one below the next one, except don't go past
+ * <end> */
+ i++;
+ upper = (i < len && array[i] < end) ? array[i] : end;
+
+ /* Here we are in a range that matches. Populate a bit in the 3-bit U8
+ * for each code point in it */
+ for (; current < upper; current++) {
+ const STRLEN offset = (STRLEN)(current - start);
+ swatch[offset >> 3] |= 1 << (offset & 7);
+ }
+
+ /* Quit if at the end of the list */
+ if (i >= len) {
+
+ /* But first, have to deal with the highest possible code point on
+ * the platform. The previous code assumes that <end> is one
+ * beyond where we want to populate, but that is impossible at the
+ * platform's infinity, so have to handle it specially */
+ if (UNLIKELY(end == UV_MAX && ELEMENT_RANGE_MATCHES_INVLIST(len-1)))
+ {
+ const STRLEN offset = (STRLEN)(end - start);
+ swatch[offset >> 3] |= 1 << (offset & 7);
+ }
+ return;
+ }
+
+ /* Advance to the next range, which will be for code points not in the
+ * inversion list */
+ current = array[i];
+ }
+
+ return;
+}
+
+void
+Perl__invlist_union(pTHX_ SV* const a, SV* const b, SV** output)
{
- /* Take the union of two inversion lists and point 'result' to it. If
- * 'result' on input points to one of the two lists, the reference count to
- * that list will be decremented.
+ /* Take the union of two inversion lists and point <output> to it. *output
+ * should be defined upon input, and if it points to one of the two lists,
+ * the reference count to that list will be decremented.
* 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
*/
UV count = 0;
- PERL_ARGS_ASSERT_INVLIST_UNION;
+ PERL_ARGS_ASSERT__INVLIST_UNION;
+ assert(a != b);
/* If either one is empty, the union is the other one */
len_a = invlist_len(a);
if (len_a == 0) {
- if (output == &a) {
+ if (*output == a) {
SvREFCNT_dec(a);
}
- else if (output != &b) {
+ if (*output != b) {
*output = invlist_clone(b);
- }
- /* else *output already = b; */
+ } /* else *output already = b; */
return;
}
else if ((len_b = invlist_len(b)) == 0) {
- if (output == &b) {
+ if (*output == b) {
SvREFCNT_dec(b);
}
- else if (output != &a) {
+ if (*output != a) {
*output = invlist_clone(a);
}
/* else *output already = a; */
* 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)))
+ || (array_a[i_a] == array_b[i_b]
+ && ELEMENT_RANGE_MATCHES_INVLIST(i_a)))
{
- cp_in_set = ELEMENT_IN_INVLIST_SET(i_a);
+ cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a);
cp= array_a[i_a++];
}
else {
- cp_in_set = ELEMENT_IN_INVLIST_SET(i_b);
+ cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b);
cp= array_b[i_b++];
}
* 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 && PREV_ELEMENT_IN_INVLIST_SET(i_a))
- || (i_b != len_b && PREV_ELEMENT_IN_INVLIST_SET(i_b)))
+ if ((i_a != len_a && PREV_RANGE_MATCHES_INVLIST(i_a))
+ || (i_b != len_b && PREV_RANGE_MATCHES_INVLIST(i_b)))
{
count--;
}
}
/* We may be removing a reference to one of the inputs */
- if (&a == output || &b == output) {
+ if (a == *output || b == *output) {
SvREFCNT_dec(*output);
}
return;
}
-STATIC void
-S_invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
+void
+Perl__invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
{
- /* Take the intersection of two inversion lists and point 'i' to it. If
- * 'i' on input points to one of the two lists, the reference count to that
- * list will be decremented.
+ /* Take the intersection of two inversion lists and point <i> to it. *i
+ * should be defined upon input, and if it points to one of the two lists,
+ * the reference count to that list will be decremented.
* 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
*/
UV count = 0;
- PERL_ARGS_ASSERT_INVLIST_INTERSECTION;
+ PERL_ARGS_ASSERT__INVLIST_INTERSECTION;
+ assert(a != b);
/* If either one is empty, the intersection is null */
len_a = invlist_len(a);
if ((len_a == 0) || ((len_b = invlist_len(b)) == 0)) {
- *i = _new_invlist(0);
/* If the result is the same as one of the inputs, the input is being
* overwritten */
- if (i == &a) {
+ if (*i == a) {
SvREFCNT_dec(a);
}
- else if (i == &b) {
+ else if (*i == b) {
SvREFCNT_dec(b);
}
+
+ *i = _new_invlist(0);
return;
}
* 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)))
+ || (array_a[i_a] == array_b[i_b]
+ && ! ELEMENT_RANGE_MATCHES_INVLIST(i_a)))
{
- cp_in_set = ELEMENT_IN_INVLIST_SET(i_a);
+ cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a);
cp= array_a[i_a++];
}
else {
- cp_in_set = ELEMENT_IN_INVLIST_SET(i_b);
+ cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b);
cp= array_b[i_b++];
}
* everything that remains in the non-exhausted set.
* 4) the exhausted wasn't in its set, non-exhausted is, count is 1, and
* remains 1. And the intersection has nothing more. */
- if ((i_a == len_a && PREV_ELEMENT_IN_INVLIST_SET(i_a))
- || (i_b == len_b && PREV_ELEMENT_IN_INVLIST_SET(i_b)))
+ if ((i_a == len_a && PREV_RANGE_MATCHES_INVLIST(i_a))
+ || (i_b == len_b && PREV_RANGE_MATCHES_INVLIST(i_b)))
{
count++;
}
}
/* We may be removing a reference to one of the inputs */
- if (&a == i || &b == i) {
+ if (a == *i || b == *i) {
SvREFCNT_dec(*i);
}
return;
}
+#endif
+
STATIC SV*
S_add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end)
{
range_invlist = _new_invlist(2);
_append_range_to_invlist(range_invlist, start, end);
- invlist_union(invlist, range_invlist, &invlist);
+ _invlist_union(invlist, range_invlist, &invlist);
/* The temporary can be freed */
SvREFCNT_dec(range_invlist);
return add_range_to_invlist(invlist, cp, cp);
}
-PERL_STATIC_INLINE void
-S_invlist_invert(pTHX_ SV* const invlist)
+#ifndef PERL_IN_XSUB_RE
+void
+Perl__invlist_invert(pTHX_ SV* const invlist)
{
/* Complement the input inversion list. This adds a 0 if the list didn't
* have a zero; removes it otherwise. As described above, the data
UV* len_pos = get_invlist_len_addr(invlist);
- PERL_ARGS_ASSERT_INVLIST_INVERT;
+ PERL_ARGS_ASSERT__INVLIST_INVERT;
/* The inverse of matching nothing is matching everything */
if (*len_pos == 0) {
}
}
+void
+Perl__invlist_invert_prop(pTHX_ SV* const invlist)
+{
+ /* Complement the input inversion list (which must be a Unicode property,
+ * all of which don't match above the Unicode maximum code point.) And
+ * Perl has chosen to not have the inversion match above that either. This
+ * adds a 0x110000 if the list didn't end with it, and removes it if it did
+ */
+
+ UV len;
+ UV* array;
+
+ PERL_ARGS_ASSERT__INVLIST_INVERT_PROP;
+
+ _invlist_invert(invlist);
+
+ len = invlist_len(invlist);
+
+ if (len != 0) { /* If empty do nothing */
+ array = invlist_array(invlist);
+ if (array[len - 1] != PERL_UNICODE_MAX + 1) {
+ /* Add 0x110000. First, grow if necessary */
+ len++;
+ if (invlist_max(invlist) < len) {
+ invlist_extend(invlist, len);
+ array = invlist_array(invlist);
+ }
+ invlist_set_len(invlist, len);
+ array[len - 1] = PERL_UNICODE_MAX + 1;
+ }
+ else { /* Remove the 0x110000 */
+ invlist_set_len(invlist, len - 1);
+ }
+ }
+
+ return;
+}
+#endif
+
PERL_STATIC_INLINE SV*
S_invlist_clone(pTHX_ SV* const invlist)
{
/* Return a new inversion list that is a copy of the input one, which is
* unchanged */
- SV* new_invlist = _new_invlist(SvCUR(invlist));
+ /* Need to allocate extra space to accommodate Perl's addition of a
+ * trailing NUL to SvPV's, since it thinks they are always strings */
+ SV* new_invlist = _new_invlist(invlist_len(invlist) + 1);
+ STRLEN length = SvCUR(invlist);
PERL_ARGS_ASSERT_INVLIST_CLONE;
- Copy(SvPVX(invlist), SvPVX(new_invlist), SvCUR(invlist), char);
+ SvCUR_set(new_invlist, length); /* This isn't done automatically */
+ Copy(SvPVX(invlist), SvPVX(new_invlist), length, char);
+
return new_invlist;
}
-STATIC void
-S_invlist_subtract(pTHX_ SV* const a, SV* const b, SV** result)
+#ifndef PERL_IN_XSUB_RE
+void
+Perl__invlist_subtract(pTHX_ SV* const a, SV* const b, SV** result)
{
- /* Point result to an inversion list which consists of all elements in 'a'
- * that aren't also in 'b' */
+ /* Point <result> to an inversion list which consists of all elements in
+ * <a> that aren't also in <b>. *result should be defined upon input, and
+ * if it points to C<b> its reference count will be decremented. */
- PERL_ARGS_ASSERT_INVLIST_SUBTRACT;
+ PERL_ARGS_ASSERT__INVLIST_SUBTRACT;
+ assert(a != b);
/* Subtracting nothing retains the original */
if (invlist_len(b) == 0) {
+ if (*result == b) {
+ SvREFCNT_dec(b);
+ }
+
/* If the result is not to be the same variable as the original, create
* a copy */
- if (result != &a) {
+ if (*result != a) {
*result = invlist_clone(a);
}
} else {
SV *b_copy = invlist_clone(b);
- invlist_invert(b_copy); /* Everything not in 'b' */
- invlist_intersection(a, b_copy, result); /* Everything in 'a' not in
+ _invlist_invert(b_copy); /* Everything not in 'b' */
+
+ if (*result == b) {
+ SvREFCNT_dec(b);
+ }
+
+ _invlist_intersection(a, b_copy, result); /* Everything in 'a' not in
'b' */
SvREFCNT_dec(b_copy);
}
- if (result == &b) {
- SvREFCNT_dec(b);
- }
-
return;
}
+#endif
PERL_STATIC_INLINE UV*
S_get_invlist_iter_addr(pTHX_ SV* invlist)
STATIC bool
S_invlist_iternext(pTHX_ SV* invlist, UV* start, UV* end)
{
+ /* An C<invlist_iterinit> call on <invlist> must be used to set this up.
+ * This call sets in <*start> and <*end>, the next range in <invlist>.
+ * Returns <TRUE> if successful and the next call will return the next
+ * range; <FALSE> if was already at the end of the list. If the latter,
+ * <*start> and <*end> are unchanged, and the next call to this function
+ * will start over at the beginning of the list */
+
UV* pos = get_invlist_iter_addr(invlist);
UV len = invlist_len(invlist);
UV *array;
return TRUE;
}
+#ifndef PERL_IN_XSUB_RE
+SV *
+Perl__invlist_contents(pTHX_ SV* const invlist)
+{
+ /* Get the contents of an inversion list into a string SV so that they can
+ * be printed out. It uses the format traditionally done for debug tracing
+ */
+
+ UV start, end;
+ SV* output = newSVpvs("\n");
+
+ PERL_ARGS_ASSERT__INVLIST_CONTENTS;
+
+ invlist_iterinit(invlist);
+ while (invlist_iternext(invlist, &start, &end)) {
+ if (end == UV_MAX) {
+ Perl_sv_catpvf(aTHX_ output, "%04"UVXf"\tINFINITY\n", start);
+ }
+ else if (end != start) {
+ Perl_sv_catpvf(aTHX_ output, "%04"UVXf"\t%04"UVXf"\n",
+ start, end);
+ }
+ else {
+ Perl_sv_catpvf(aTHX_ output, "%04"UVXf"\n", start);
+ }
+ }
+
+ return output;
+}
+#endif
+
#if 0
void
S_invlist_dump(pTHX_ SV* const invlist, const char * const header)
RExC_parse++;
if (*RExC_parse!=')')
vFAIL("Expecting close bracket");
-
+
gen_recurse_regop:
if ( paren == '-' ) {
/*
RExC_parse++;
}
if (*RExC_parse != ')') {
- RExC_parse = s;
+ RExC_parse = s;
vFAIL("Sequence (?{...}) not terminated or not {}-balanced");
}
if (!SIZE_ONLY) {
|| RExC_parse[1] == '<'
|| RExC_parse[1] == '{') { /* Lookahead or eval. */
I32 flag;
-
+
ret = reg_node(pRExC_state, LOGICAL);
if (!SIZE_ONLY)
ret->flags = 1;
Set_Node_Length(ret, 1);
}
}
-
+
if (!first && SIZE_ONLY)
RExC_extralen += 1; /* BRANCHJ */
break;
case 'p':
case 'P':
- {
+ {
char* const oldregxend = RExC_end;
#ifdef DEBUGGING
char* parse_start = RExC_parse - 2;
STRLEN foldlen;
U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf;
regnode * orig_emit;
+ U8 node_type;
ender = 0;
orig_emit = RExC_emit; /* Save the original output node position in
case we need to output a different node
type */
- ret = reg_node(pRExC_state,
- (U8) ((! FOLD) ? EXACT
- : (LOC)
- ? EXACTFL
- : (MORE_ASCII_RESTRICTED)
- ? EXACTFA
- : (AT_LEAST_UNI_SEMANTICS)
- ? EXACTFU
- : EXACTF)
- );
+ node_type = ((! FOLD) ? EXACT
+ : (LOC)
+ ? EXACTFL
+ : (MORE_ASCII_RESTRICTED)
+ ? EXACTFA
+ : (AT_LEAST_UNI_SEMANTICS)
+ ? EXACTFU
+ : EXACTF);
+ ret = reg_node(pRExC_state, node_type);
s = STRING(ret);
+
+ /* XXX The node can hold up to 255 bytes, yet this only goes to
+ * 127. I (khw) do not know why. Keeping it somewhat less than
+ * 255 allows us to not have to worry about overflow due to
+ * converting to utf8 and fold expansion, but that value is
+ * 255-UTF8_MAXBYTES_CASE. join_exact() may join adjacent nodes
+ * split up by this limit into a single one using the real max of
+ * 255. Even at 127, this breaks under rare circumstances. If
+ * folding, we do not want to split a node at a character that is a
+ * non-final in a multi-char fold, as an input string could just
+ * happen to want to match across the node boundary. The join
+ * would solve that problem if the join actually happens. But a
+ * series of more than two nodes in a row each of 127 would cause
+ * the first join to succeed to get to 254, but then there wouldn't
+ * be room for the next one, which could at be one of those split
+ * multi-char folds. I don't know of any fool-proof solution. One
+ * could back off to end with only a code point that isn't such a
+ * non-final, but it is possible for there not to be any in the
+ * entire node. */
for (len = 0, p = RExC_parse - 1;
- len < 127 && p < RExC_end;
- len++)
+ len < 127 && p < RExC_end;
+ len++)
{
char * const oldp = p;
case 'x':
if (*++p == '{') {
char* const e = strchr(p, '}');
-
+
if (!e) {
RExC_parse = p + 1;
vFAIL("Missing right brace on \\x{}");
*flagp |= HASWIDTH;
if (len == 1 && UNI_IS_INVARIANT(ender))
*flagp |= SIMPLE;
-
+
if (SIZE_ONLY)
RExC_size += STR_SZ(len);
else {
POSIXCC(UCHARAT(RExC_parse))) {
const char c = UCHARAT(RExC_parse);
char* const s = RExC_parse++;
-
+
while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != c)
RExC_parse++;
if (RExC_parse == RExC_end)
}
}
-/* No locale test, and always Unicode semantics */
+/* No locale test, and always Unicode semantics, no ignore-case differences */
#define _C_C_T_NOLOC_(NAME,TEST,WORD) \
ANYOF_##NAME: \
for (value = 0; value < 256; value++) \
/* 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) \
+ * parameter.
+ * Sets 'what' to WORD which is the property name for non-bitmap code points;
+ * But, uses FOLD_WORD instead if /i has been selected, to allow a different
+ * property name */
+#define _C_C_T_(NAME, TEST_8, TEST_7, WORD, FOLD_WORD) \
ANYOF_##NAME: \
if (LOC) ANYOF_CLASS_SET(ret, ANYOF_##NAME); \
else if (UNI_SEMANTICS) { \
} \
} \
yesno = '+'; \
- what = WORD; \
+ if (FOLD) { \
+ what = FOLD_WORD; \
+ } \
+ else { \
+ what = WORD; \
+ } \
break; \
case ANYOF_N##NAME: \
if (LOC) ANYOF_CLASS_SET(ret, ANYOF_N##NAME); \
} \
} \
yesno = '!'; \
- what = WORD; \
+ if (FOLD) { \
+ what = FOLD_WORD; \
+ } \
+ else { \
+ what = WORD; \
+ } \
break
STATIC U8
SV *listsv = NULL;
STRLEN initial_listsv_len = 0; /* Kind of a kludge to see if it is more
than just initialized. */
+ SV* properties = NULL; /* Code points that match \p{} \P{} */
+ UV element_count = 0; /* Number of distinct elements in the class.
+ Optimizations may be possible if this is tiny */
UV n;
+ /* Unicode properties are stored in a swash; this holds the current one
+ * being parsed. If this swash is the only above-latin1 component of the
+ * character class, an optimization is to pass it directly on to the
+ * execution engine. Otherwise, it is set to NULL to indicate that there
+ * are other things in the class that have to be dealt with at execution
+ * time */
+ SV* swash = NULL; /* Code points that match \p{} \P{} */
+
+ /* Set if a component of this character class is user-defined; just passed
+ * on to the engine */
+ UV has_user_defined_property = 0;
+
/* code points this node matches that can't be stored in the bitmap */
SV* nonbitmap = NULL;
namedclass = OOB_NAMEDCLASS; /* initialize as illegal */
- if (!range)
+ if (!range) {
rangebegin = RExC_parse;
+ element_count++;
+ }
if (UTF) {
value = utf8n_to_uvchr((U8*)RExC_parse,
RExC_end - RExC_parse,
n = 1;
}
if (!SIZE_ONLY) {
+ SV** invlistsvp;
+ SV* invlist;
+ char* name;
if (UCHARAT(RExC_parse) == '^') {
RExC_parse++;
n--;
n--;
}
}
+ /* Try to get the definition of the property into
+ * <invlist>. If /i is in effect, the effective property
+ * will have its name be <__NAME_i>. The design is
+ * discussed in commit
+ * 2f833f5208e26b208886e51e09e2c072b5eabb46 */
+ Newx(name, n + sizeof("_i__\n"), char);
+
+ sprintf(name, "%s%.*s%s\n",
+ (FOLD) ? "__" : "",
+ (int)n,
+ RExC_parse,
+ (FOLD) ? "_i" : ""
+ );
+
+ /* Look up the property name, and get its swash and
+ * inversion list, if the property is found */
+ if (swash) {
+ SvREFCNT_dec(swash);
+ }
+ swash = _core_swash_init("utf8", name, &PL_sv_undef,
+ 1, /* binary */
+ 0, /* not tr/// */
+ TRUE, /* this routine will handle
+ undefined properties */
+ NULL, FALSE /* No inversion list */
+ );
+ if ( ! swash
+ || ! SvROK(swash)
+ || ! SvTYPE(SvRV(swash)) == SVt_PVHV
+ || ! (invlistsvp =
+ hv_fetchs(MUTABLE_HV(SvRV(swash)),
+ "INVLIST", FALSE))
+ || ! (invlist = *invlistsvp))
+ {
+ if (swash) {
+ SvREFCNT_dec(swash);
+ swash = NULL;
+ }
+
+ /* Here didn't find it. It could be a user-defined
+ * property that will be available at run-time. Add it
+ * to the list to look up then */
+ Perl_sv_catpvf(aTHX_ listsv, "%cutf8::%s\n",
+ (value == 'p' ? '+' : '!'),
+ name);
+ has_user_defined_property = 1;
+
+ /* We don't know yet, so have to assume that the
+ * property could match something in the Latin1 range,
+ * hence something that isn't utf8 */
+ ANYOF_FLAGS(ret) |= ANYOF_NONBITMAP_NON_UTF8;
+ }
+ else {
+
+ /* Here, did get the swash and its inversion list. If
+ * the swash is from a user-defined property, then this
+ * whole character class should be regarded as such */
+ SV** user_defined_svp =
+ hv_fetchs(MUTABLE_HV(SvRV(swash)),
+ "USER_DEFINED", FALSE);
+ if (user_defined_svp) {
+ has_user_defined_property
+ |= SvUV(*user_defined_svp);
+ }
+
+ /* Invert if asking for the complement */
+ if (value == 'P') {
+
+ /* Add to any existing list */
+ if (! properties) {
+ properties = invlist_clone(invlist);
+ _invlist_invert(properties);
+ }
+ else {
+ invlist = invlist_clone(invlist);
+ _invlist_invert(invlist);
+ _invlist_union(properties, invlist, &properties);
+ SvREFCNT_dec(invlist);
+ }
- /* 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" : ""
- );
+ /* The swash can't be used as-is, because we've
+ * inverted things; delay removing it to here after
+ * have copied its invlist above */
+ SvREFCNT_dec(swash);
+ swash = NULL;
+ }
+ else {
+ if (! properties) {
+ properties = invlist_clone(invlist);
+ }
+ else {
+ _invlist_union(properties, invlist, &properties);
+ }
+ }
+ }
+ Safefree(name);
}
RExC_parse = e + 1;
-
- /* The \p could match something in the Latin1 range, hence
- * something that isn't utf8 */
- ANYOF_FLAGS(ret) |= ANYOF_NONBITMAP_NON_UTF8;
namedclass = ANYOF_MAX; /* no official name, but it's named */
/* \p means they want Unicode semantics */
range = 0; /* this was not a true range */
}
-
-
if (!SIZE_ONLY) {
const char *what = NULL;
char yesno = 0;
* --jhi */
switch ((I32)namedclass) {
- 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");
+ case _C_C_T_(ALNUMC, isALNUMC_L1, isALNUMC, "XPosixAlnum", "XPosixAlnum");
+ case _C_C_T_(ALPHA, isALPHA_L1, isALPHA, "XPosixAlpha", "XPosixAlpha");
+ case _C_C_T_(BLANK, isBLANK_L1, isBLANK, "XPosixBlank", "XPosixBlank");
+ case _C_C_T_(CNTRL, isCNTRL_L1, isCNTRL, "XPosixCntrl", "XPosixCntrl");
+ case _C_C_T_(GRAPH, isGRAPH_L1, isGRAPH, "XPosixGraph", "XPosixGraph");
+ case _C_C_T_(LOWER, isLOWER_L1, isLOWER, "XPosixLower", "__XPosixLower_i");
+ case _C_C_T_(PRINT, isPRINT_L1, isPRINT, "XPosixPrint", "XPosixPrint");
+ case _C_C_T_(PSXSPC, isPSXSPC_L1, isPSXSPC, "XPosixSpace", "XPosixSpace");
+ case _C_C_T_(PUNCT, isPUNCT_L1, isPUNCT, "XPosixPunct", "XPosixPunct");
+ case _C_C_T_(UPPER, isUPPER_L1, isUPPER, "XPosixUpper", "__XPosixUpper_i");
/* \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");
- case _C_C_T_(XDIGIT, isXDIGIT_L1, isXDIGIT, "XPosixXDigit");
+ case _C_C_T_(SPACE, isSPACE_L1, isSPACE, "SpacePerl", "SpacePerl");
+ case _C_C_T_(ALNUM, isWORDCHAR_L1, isALNUM, "Word", "Word");
+ case _C_C_T_(XDIGIT, isXDIGIT_L1, isXDIGIT, "XPosixXDigit", "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 (what && ! (AT_LEAST_ASCII_RESTRICTED)) {
/* Strings such as "+utf8::isWord\n" */
- Perl_sv_catpvf(aTHX_ listsv, "%cutf8::Is%s\n", yesno, what);
+ Perl_sv_catpvf(aTHX_ listsv, "%cutf8::%s\n", yesno, what);
}
continue;
if (FOLD && nonbitmap) {
UV start, end; /* End points of code point ranges */
- SV* fold_intersection;
+ SV* fold_intersection = NULL;
/* 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);
+ SvREFCNT_dec(swash);
}
/* This is a hash that for a particular fold gives all characters
if (! PL_utf8_tofold) {
U8 dummy[UTF8_MAXBYTES+1];
STRLEN dummy_len;
- to_utf8_fold((U8*) "A", dummy, &dummy_len);
+
+ /* This particular string is above \xff in both UTF-8 and
+ * UTFEBCDIC */
+ to_utf8_fold((U8*) "\xC8\x80", dummy, &dummy_len);
+ assert(PL_utf8_tofold); /* Verify that worked */
}
PL_utf8_foldclosures = _swash_inversion_hash(PL_utf8_tofold);
}
}
- /* Only the characters in this class that participate in folds need
- * be checked. Get the intersection of this class and all the
- * possible characters that are foldable. This can quickly narrow
- * down a large class */
- invlist_intersection(PL_utf8_foldable, nonbitmap, &fold_intersection);
+ /* Only the characters in this class that participate in folds need be
+ * checked. Get the intersection of this class and all the possible
+ * characters that are foldable. This can quickly narrow down a large
+ * class */
+ _invlist_intersection(PL_utf8_foldable, nonbitmap, &fold_intersection);
/* Now look at the foldable characters in this class individually */
invlist_iterinit(fold_intersection);
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. */
+ /* 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) {
U8* loc = foldbuf;
U8* e = foldbuf + foldlen;
- /* If any of the folded characters of this are in
- * the Latin1 range, tell the regex engine that
- * this can match a non-utf8 target string. The
- * only multi-byte fold whose source is in the
- * Latin1 range (U+00DF) applies only when the
- * target string is utf8, or under unicode rules */
+ /* If any of the folded characters of this are in the
+ * Latin1 range, tell the regex engine that this can
+ * match a non-utf8 target string. The only multi-byte
+ * fold whose source is in the Latin1 range (U+00DF)
+ * applies only when the target string is utf8, or
+ * under unicode rules */
if (j > 255 || AT_LEAST_UNI_SEMANTICS) {
while (loc < e) {
if (UTF8_IS_INVARIANT(*loc)
|| UTF8_IS_DOWNGRADEABLE_START(*loc))
{
- /* Can't mix above and below 256 under
- * LOC */
+ /* Can't mix above and below 256 under LOC
+ */
if (LOC) {
goto end_multi_fold;
}
}
else {
/* Single character fold. Add everything in its fold
- * closure to the list that this node should match */
+ * closure to the list that this node should match */
SV** listp;
- /* The fold closures data structure is a hash with the
- * keys being 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 ] */
+ /* The fold closures data structure is a hash with the keys
+ * being 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)))
{
}
c = SvUV(*c_p);
- /* /aa doesn't allow folds between ASCII and
- * non-; /l doesn't allow them between above
- * and below 256 */
+ /* /aa doesn't allow folds between ASCII and non-;
+ * /l doesn't allow them between above and below
+ * 256 */
if ((MORE_ASCII_RESTRICTED
&& (isASCII(c) != isASCII(j)))
|| (LOC && ((c < 256) != (j < 256))))
(U8) c,
&l1_fold_invlist, &unicode_alternate);
}
- /* It may be that the code point is already
- * in this range or already in the bitmap,
- * in which case we need do nothing */
+ /* It may be that the code point is already in
+ * this range or already in the bitmap, in
+ * which case we need do nothing */
else if ((c < start || c > end)
&& (c > 255
|| ! ANYOF_BITMAP_TEST(ret, c)))
/* Combine the two lists into one. */
if (l1_fold_invlist) {
if (nonbitmap) {
- invlist_union(nonbitmap, l1_fold_invlist, &nonbitmap);
+ _invlist_union(nonbitmap, l1_fold_invlist, &nonbitmap);
SvREFCNT_dec(l1_fold_invlist);
}
else {
}
}
+ /* And combine the result (if any) with any inversion list from properties.
+ * The lists are kept separate up to now because we don't want to fold the
+ * properties */
+ if (properties) {
+ if (nonbitmap) {
+ _invlist_union(nonbitmap, properties, &nonbitmap);
+ SvREFCNT_dec(properties);
+ }
+ else {
+ nonbitmap = properties;
+ }
+ }
+
+ /* Here, <nonbitmap> contains all the code points we can determine at
+ * compile time that we haven't put into the bitmap. Go through it, and
+ * for things that belong in the bitmap, put them there, and delete from
+ * <nonbitmap> */
+ if (nonbitmap) {
+
+ /* Above-ASCII code points in /d have to stay in <nonbitmap>, as they
+ * possibly only should match when the target string is UTF-8 */
+ UV max_cp_to_set = (DEPENDS_SEMANTICS) ? 127 : 255;
+
+ /* This gets set if we actually need to modify things */
+ bool change_invlist = FALSE;
+
+ UV start, end;
+
+ /* Start looking through <nonbitmap> */
+ invlist_iterinit(nonbitmap);
+ while (invlist_iternext(nonbitmap, &start, &end)) {
+ UV high;
+ int i;
+
+ /* Quit if are above what we should change */
+ if (start > max_cp_to_set) {
+ break;
+ }
+
+ change_invlist = TRUE;
+
+ /* Set all the bits in the range, up to the max that we are doing */
+ high = (end < max_cp_to_set) ? end : max_cp_to_set;
+ for (i = start; i <= (int) high; i++) {
+ if (! ANYOF_BITMAP_TEST(ret, i)) {
+ ANYOF_BITMAP_SET(ret, i);
+ stored++;
+ prevvalue = value;
+ value = i;
+ }
+ }
+ }
+
+ /* Done with loop; set <nonbitmap> to not include any code points that
+ * are in the bitmap */
+ if (change_invlist) {
+ SV* keep_list = _new_invlist(2);
+ _append_range_to_invlist(keep_list, max_cp_to_set + 1, UV_MAX);
+ _invlist_intersection(nonbitmap, keep_list, &nonbitmap);
+ SvREFCNT_dec(keep_list);
+ }
+
+ /* If have completely emptied it, remove it completely */
+ if (invlist_len(nonbitmap) == 0) {
+ SvREFCNT_dec(nonbitmap);
+ nonbitmap = NULL;
+ }
+ }
+
/* Here, we have calculated what code points should be in the character
- * class. Now we can see about various optimizations. Fold calculation
- * needs to take place before inversion. Otherwise /[^k]/i would invert to
- * include K, which under /i would match k. */
+ * class. <nonbitmap> does not overlap the bitmap except possibly in the
+ * case of DEPENDS rules.
+ *
+ * Now we can see about various optimizations. Fold calculation (which we
+ * did above) needs to take place before inversion. Otherwise /[^k]/i
+ * would invert to include K, which under /i would match k, which it
+ * shouldn't. */
/* 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
+ * set the FOLD flag yet, so 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_INVERT)
+ if ((ANYOF_FLAGS(ret) & ANYOF_INVERT)
+ && ! LOC
&& ! unicode_alternate
/* In case of /d, there are some things that should match only when in
* not in the bitmap, i.e., they require UTF8 to match. These are
- * listed in nonbitmap. */
+ * listed in nonbitmap, but if ANYOF_NONBITMAP_NON_UTF8 is set in this
+ * case, they don't require UTF8, so can invert here */
&& (! nonbitmap
|| ! DEPENDS_SEMANTICS
|| (ANYOF_FLAGS(ret) & ANYOF_NONBITMAP_NON_UTF8))
&& SvCUR(listsv) == initial_listsv_len)
{
+ int i;
if (! nonbitmap) {
- for (value = 0; value < ANYOF_BITMAP_SIZE; ++value)
- ANYOF_BITMAP(ret)[value] ^= 0xFF;
+ for (i = 0; i < 256; ++i) {
+ if (ANYOF_BITMAP_TEST(ret, i)) {
+ ANYOF_BITMAP_CLEAR(ret, i);
+ }
+ else {
+ ANYOF_BITMAP_SET(ret, i);
+ prevvalue = value;
+ value = i;
+ }
+ }
/* The inversion means that everything above 255 is matched */
ANYOF_FLAGS(ret) |= ANYOF_UNICODE_ALL;
}
else {
- /* Here, also has things outside the bitmap. Go through each bit
- * individually and add it to the list to get rid of from those
- * things not in the bitmap */
- SV *remove_list = _new_invlist(2);
- invlist_invert(nonbitmap);
- for (value = 0; value < 256; ++value) {
- if (ANYOF_BITMAP_TEST(ret, value)) {
- ANYOF_BITMAP_CLEAR(ret, value);
- remove_list = add_cp_to_invlist(remove_list, value);
+ /* Here, also has things outside the bitmap that may overlap with
+ * the bitmap. We have to sync them up, so that they get inverted
+ * in both places. Earlier, we removed all overlaps except in the
+ * case of /d rules, so no syncing is needed except for this case
+ */
+ SV *remove_list = NULL;
+
+ if (DEPENDS_SEMANTICS) {
+ UV start, end;
+
+ /* Set the bits that correspond to the ones that aren't in the
+ * bitmap. Otherwise, when we invert, we'll miss these.
+ * Earlier, we removed from the nonbitmap all code points
+ * < 128, so there is no extra work here */
+ invlist_iterinit(nonbitmap);
+ while (invlist_iternext(nonbitmap, &start, &end)) {
+ if (start > 255) { /* The bit map goes to 255 */
+ break;
+ }
+ if (end > 255) {
+ end = 255;
+ }
+ for (i = start; i <= (int) end; ++i) {
+ ANYOF_BITMAP_SET(ret, i);
+ prevvalue = value;
+ value = i;
+ }
+ }
+ }
+
+ /* Now invert both the bitmap and the nonbitmap. Anything in the
+ * bitmap has to also be removed from the non-bitmap, but again,
+ * there should not be overlap unless is /d rules. */
+ _invlist_invert(nonbitmap);
+
+ for (i = 0; i < 256; ++i) {
+ if (ANYOF_BITMAP_TEST(ret, i)) {
+ ANYOF_BITMAP_CLEAR(ret, i);
+ if (DEPENDS_SEMANTICS) {
+ if (! remove_list) {
+ remove_list = _new_invlist(2);
+ }
+ remove_list = add_cp_to_invlist(remove_list, i);
+ }
}
else {
- ANYOF_BITMAP_SET(ret, value);
+ ANYOF_BITMAP_SET(ret, i);
+ prevvalue = value;
+ value = i;
+ }
+ }
+
+ /* And do the removal */
+ if (DEPENDS_SEMANTICS) {
+ if (remove_list) {
+ _invlist_subtract(nonbitmap, remove_list, &nonbitmap);
+ SvREFCNT_dec(remove_list);
}
}
- invlist_subtract(nonbitmap, remove_list, &nonbitmap);
- SvREFCNT_dec(remove_list);
+ else {
+ /* There is no overlap for non-/d, so just delete anything
+ * below 256 */
+ SV* keep_list = _new_invlist(2);
+ _append_range_to_invlist(keep_list, 256, UV_MAX);
+ _invlist_intersection(nonbitmap, keep_list, &nonbitmap);
+ SvREFCNT_dec(keep_list);
+ }
}
stored = 256 - stored;
/* 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 (FOLD && (LOC || nonbitmap || unicode_alternate)) {
+ * for some things not in the bitmap (only the upper latin folds in this
+ * case, as all other single-char folding has been set above). Set
+ * run-time fold flag for these */
+ if (FOLD && (LOC
+ || (DEPENDS_SEMANTICS
+ && nonbitmap
+ && ! (ANYOF_FLAGS(ret) & ANYOF_NONBITMAP_NON_UTF8))
+ || unicode_alternate))
+ {
ANYOF_FLAGS(ret) |= ANYOF_LOC_NONBITMAP_FOLD;
}
else {
op = EXACT;
}
- } /* else 2 chars in the bit map: the folds of each other */
- else if (AT_LEAST_UNI_SEMANTICS || !isASCII(value)) {
+ }
+ else { /* else 2 chars in the bit map: the folds of each other */
+
+ /* Use the folded value, which for the cases where we get here,
+ * is just the lower case of the current one (which may resolve to
+ * itself, or to the other one */
+ value = toLOWER_LATIN1(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;
+ * Try to use the most likely type, by using EXACTFA if possible,
+ * then EXACTFU if the regex calls for it, or is required because
+ * the character is non-ASCII. (If <value> is ASCII, its fold is
+ * also ASCII for the cases where we get here.) */
+ if (MORE_ASCII_RESTRICTED && isASCII(value)) {
+ op = EXACTFA;
+ }
+ else if (AT_LEAST_UNI_SEMANTICS || !isASCII(value)) {
+ op = EXACTFU;
+ }
+ else { /* Otherwise, more likely to be EXACTF type */
+ op = EXACTF;
+ }
}
ret = reg_node(pRExC_state, op);
return ret;
}
- if (nonbitmap) {
- UV start, end;
- invlist_iterinit(nonbitmap);
- while (invlist_iternext(nonbitmap, &start, &end)) {
- 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);
- }
- }
- SvREFCNT_dec(nonbitmap);
+ /* If there is a swash and more than one element, we can't use the swash in
+ * the optimization below. */
+ if (swash && element_count > 1) {
+ SvREFCNT_dec(swash);
+ swash = NULL;
}
-
- if (SvCUR(listsv) == initial_listsv_len && ! unicode_alternate) {
+ if (! nonbitmap
+ && SvCUR(listsv) == initial_listsv_len
+ && ! unicode_alternate)
+ {
ARG_SET(ret, ANYOF_NONBITMAP_EMPTY);
SvREFCNT_dec(listsv);
SvREFCNT_dec(unicode_alternate);
}
else {
-
+ /* av[0] stores the character class description in its textual form:
+ * used later (regexec.c:Perl_regclass_swash()) to initialize the
+ * appropriate swash, and is also useful for dumping the regnode.
+ * av[1] if NULL, is a placeholder to later contain the swash computed
+ * from av[0]. But if no further computation need be done, the
+ * swash is stored there now.
+ * av[2] stores the multicharacter foldings, used later in
+ * regexec.c:S_reginclass().
+ * av[3] stores the nonbitmap inversion list for use in addition or
+ * instead of av[0]; not used if av[1] isn't NULL
+ * av[4] is set if any component of the class is from a user-defined
+ * property; not used if av[1] isn't NULL */
AV * const av = newAV();
SV *rv;
- /* The 0th element stores the character class description
- * in its textual form: used later (regexec.c:Perl_regclass_swash())
- * to initialize the appropriate swash (which gets stored in
- * the 1st element), and also useful for dumping the regnode.
- * The 2nd element stores the multicharacter foldings,
- * used later (regexec.c:S_reginclass()). */
- av_store(av, 0, listsv);
- av_store(av, 1, NULL);
+
+ av_store(av, 0, (SvCUR(listsv) == initial_listsv_len)
+ ? &PL_sv_undef
+ : listsv);
+ if (swash) {
+ av_store(av, 1, swash);
+ SvREFCNT_dec(nonbitmap);
+ }
+ else {
+ av_store(av, 1, NULL);
+ if (nonbitmap) {
+ av_store(av, 3, nonbitmap);
+ av_store(av, 4, newSVuv(has_user_defined_property));
+ }
+ }
/* Store any computed multi-char folds only if we are allowing
* them */
PERL_ARGS_ASSERT_NEXTCHAR;
for (;;) {
- if (*RExC_parse == '(' && RExC_parse[1] == '?' &&
- RExC_parse[2] == '#') {
+ if (RExC_end - RExC_parse >= 3
+ && *RExC_parse == '('
+ && RExC_parse[1] == '?'
+ && RExC_parse[2] == '#')
+ {
while (*RExC_parse != ')') {
if (RExC_parse == RExC_end)
FAIL("Sequence (?#... not terminated");
return(ret);
}
if (RExC_emit >= RExC_emit_bound)
- Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d", op);
+ Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d, %p>=%p",
+ op, RExC_emit, RExC_emit_bound);
NODE_ALIGN_FILL(ret);
ptr = ret;
We can't do this:
assert(2==regarglen[op]+1);
-
+
Anything larger than this has to allocate the extra amount.
If we changed this to be:
return(ret);
}
if (RExC_emit >= RExC_emit_bound)
- Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d", op);
+ Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d, %p>=%p",
+ op, RExC_emit, RExC_emit_bound);
NODE_ALIGN_FILL(ret);
ptr = ret;
case EXACTF:
case EXACTFA:
case EXACTFU:
+ case EXACTFU_SS:
+ case EXACTFU_NO_TRIE:
case EXACTFL:
if( exact == PSEUDO )
exact= OP(scan);
Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]);
if (flags & ANYOF_INVERT)
sv_catpvs(sv, "^");
-
+
/* output what the standard cp 0-255 bitmap matches */
for (i = 0; i <= 256; i++) {
if (i < 256 && ANYOF_BITMAP_TEST(o,i)) {
sv_catpvs(sv, "{outside bitmap}");
if (ANYOF_NONBITMAP(o)) {
- SV *lv;
+ SV *lv; /* Set if there is something outside the bit map */
SV * const sw = regclass_swash(prog, o, FALSE, &lv, 0);
-
- if (lv) {
+ bool byte_output = FALSE; /* If something in the bitmap has been
+ output */
+
+ if (lv && lv != &PL_sv_undef) {
if (sw) {
U8 s[UTF8_MAXBYTES_CASE+1];
- for (i = 0; i <= 256; i++) { /* just the first 256 */
+ for (i = 0; i <= 256; i++) { /* Look at chars in bitmap */
uvchr_to_utf8(s, i);
-
- if (i < 256 && swash_fetch(sw, s, TRUE)) {
+
+ if (i < 256
+ && ! ANYOF_BITMAP_TEST(o, i) /* Don't duplicate
+ things already
+ output as part
+ of the bitmap */
+ && swash_fetch(sw, s, TRUE))
+ {
if (rangestart == -1)
rangestart = i;
} else if (rangestart != -1) {
+ byte_output = TRUE;
if (i <= rangestart + 3)
for (; rangestart < i; rangestart++) {
- const U8 * const e = uvchr_to_utf8(s,rangestart);
- U8 *p;
- for(p = s; p < e; p++)
- put_byte(sv, *p);
+ put_byte(sv, rangestart);
}
else {
- const U8 *e = uvchr_to_utf8(s,rangestart);
- U8 *p;
- for (p = s; p < e; p++)
- put_byte(sv, *p);
+ put_byte(sv, rangestart);
sv_catpvs(sv, "-");
- e = uvchr_to_utf8(s, i-1);
- for (p = s; p < e; p++)
- put_byte(sv, *p);
- }
- rangestart = -1;
+ put_byte(sv, i-1);
}
+ rangestart = -1;
}
-
- sv_catpvs(sv, "..."); /* et cetera */
+ }
}
{
char *s = savesvpv(lv);
char * const origs = s;
-
+
while (*s && *s != '\n')
s++;
-
+
if (*s == '\n') {
const char * const t = ++s;
-
+
+ if (byte_output) {
+ sv_catpvs(sv, " ");
+ }
+
while (*s) {
- if (*s == '\n')
+ if (*s == '\n') {
+
+ /* Truncate very long output */
+ if (s - origs > 256) {
+ Perl_sv_catpvf(aTHX_ sv,
+ "%.*s...",
+ (int) (s - origs - 1),
+ t);
+ goto out_dump;
+ }
*s = ' ';
+ }
+ else if (*s == '\t') {
+ *s = '-';
+ }
s++;
}
if (s[-1] == ' ')
s[-1] = 0;
-
+
sv_catpv(sv, t);
}
-
+
+ out_dump:
+
Safefree(origs);
}
+ SvREFCNT_dec(lv);
}
}
1: a buffer in a different thread
2: something we no longer hold a reference on
so we need to copy it locally. */
- /* Note we need to sue SvCUR() on our mother_re, because it, in
+ /* Note we need to use SvCUR(), rather than
+ SvLEN(), on our mother_re, because it, in
turn, may well be pointing to its own mother_re. */
SvPV_set(dstr, SAVEPVN(SvPVX_const(ret->mother_re),
SvCUR(ret->mother_re)+1));
}
#endif
-STATIC void
+STATIC void
S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
{
va_list args;
goto after_print;
} else
CLEAR_OPTSTART;
-
+
regprop(r, sv, node);
PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start),
(int)(2*indent + 1), "", SvPVX_const(sv));
sv_setpvs(sv, "");
for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) {
SV ** const elem_ptr = av_fetch(trie_words,word_idx,0);
-
+
PerlIO_printf(Perl_debug_log, "%*s%s ",
(int)(2*(indent+3)), "",
elem_ptr ? pv_pretty(sv, SvPV_nolen_const(*elem_ptr), SvCUR(*elem_ptr), 60,
https://perl5.git.perl.org / perl5.git / blobdiff