regnode_ssc *start_class;
} scan_data_t;
-/* The below is perhaps overboard, but this allows us to save a test at the
- * expense of a mask. This is because on both EBCDIC and ASCII machines, 'A'
- * and 'a' differ by a single bit; the same with the upper and lower case of
- * all other ASCII-range alphabetics. On ASCII platforms, they are 32 apart;
- * on EBCDIC, they are 64. This uses an exclusive 'or' to find that bit and
- * then inverts it to form a mask, with just a single 0, in the bit position
- * where the upper- and lowercase differ. XXX There are about 40 other
- * instances in the Perl core where this micro-optimization could be used.
- * Should decide if maintenance cost is worse, before changing those
- *
- * Returns a boolean as to whether or not 'v' is either a lowercase or
- * uppercase instance of 'c', where 'c' is in [A-Za-z]. If 'c' is a
- * compile-time constant, the generated code is better than some optimizing
- * compilers figure out, amounting to a mask and test. The results are
- * meaningless if 'c' is not one of [A-Za-z] */
-#define isARG2_lower_or_UPPER_ARG1(c, v) \
- (((v) & ~('A' ^ 'a')) == ((c) & ~('A' ^ 'a')))
-
/*
* Forward declarations for pregcomp()'s friends.
*/
}
}
- /* An ANYOF node contains a bitmap for the first 256 code points, and an
- * inversion list for the others, but if there are code points that should
- * match only conditionally on the target string being UTF-8, those are
- * placed in the inversion list, and not the bitmap. Since there are
- * circumstances under which they could match, they are included in the
- * SSC. But if the ANYOF node is to be inverted, we have to exclude them
- * here, so that when we invert below, the end result actually does include
- * them. (Think about "\xe0" =~ /[^\xc0]/di;). We have to do this here
- * before we add the unconditionally matched code points */
+ /* An ANYOF node contains a bitmap for the first NUM_ANYOF_CODE_POINTS
+ * code points, and an inversion list for the others, but if there are code
+ * points that should match only conditionally on the target string being
+ * UTF-8, those are placed in the inversion list, and not the bitmap.
+ * Since there are circumstances under which they could match, they are
+ * included in the SSC. But if the ANYOF node is to be inverted, we have
+ * to exclude them here, so that when we invert below, the end result
+ * actually does include them. (Think about "\xe0" =~ /[^\xc0]/di;). We
+ * have to do this here before we add the unconditionally matched code
+ * points */
if (ANYOF_FLAGS(node) & ANYOF_INVERT) {
_invlist_intersection_complement_2nd(invlist,
PL_UpperLatin1,
}
/* Add in the points from the bit map */
- for (i = 0; i < 256; i++) {
+ for (i = 0; i < NUM_ANYOF_CODE_POINTS; i++) {
if (ANYOF_BITMAP_TEST(node, i)) {
invlist = add_cp_to_invlist(invlist, i);
new_node_has_latin1 = TRUE;
{
/* The inversion list in the SSC is marked mortal; now we need a more
* permanent copy, which is stored the same way that is done in a regular
- * ANYOF node, with the first 256 code points in a bit map */
+ * ANYOF node, with the first NUM_ANYOF_CODE_POINTS code points in a bit
+ * map */
SV* invlist = invlist_clone(ssc->invlist);
}
if (len == 2
- && isARG2_lower_or_UPPER_ARG1('s', *s)
- && isARG2_lower_or_UPPER_ARG1('s', *(s+1)))
+ && isALPHA_FOLD_EQ(*s, 's')
+ && isALPHA_FOLD_EQ(*(s+1), 's'))
{
/* EXACTF nodes need to know that the minimum length
else if ( PL_regkind[OP(scan)] == BRANCHJ
/* Lookbehind, or need to calculate parens/evals/stclass: */
&& (scan->flags || data || (flags & SCF_DO_STCLASS))
- && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
+ && (OP(scan) == IFMATCH || OP(scan) == UNLESSM))
+ {
if ( OP(scan) == UNLESSM &&
scan->flags == 0 &&
OP(NEXTOPER(NEXTOPER(scan))) == NOTHING &&
*/
ssc_init(pRExC_state, data->start_class);
} else {
- /* AND before and after: combine and continue */
+ /* AND before and after: combine and continue. These
+ * assertions are zero-length, so can match an EMPTY
+ * string */
ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &intrnl);
+ ANYOF_FLAGS(data->start_class) |= ANYOF_EMPTY_STRING;
}
}
}
if (f & SCF_DO_STCLASS_AND) {
ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &intrnl);
+ ANYOF_FLAGS(data->start_class) |= ANYOF_EMPTY_STRING;
}
if (data) {
if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
REGTAIL(pRExC_state, ret, tail);
goto insert_if;
}
+ /* Fall through to ‘Unknown switch condition’ at the
+ end of the if/else chain. */
}
else if ( RExC_parse[0] == '<' /* (?(<NAME>)...) */
|| RExC_parse[0] == '\'' ) /* (?('NAME')...) */
but I can't figure out why. -- dmq*/
return ret;
}
- else {
- RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1;
- vFAIL("Unknown switch condition (?(...))");
- }
+ RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1;
+ vFAIL("Unknown switch condition (?(...))");
}
case '[': /* (?[ ... ]) */
return handle_regex_sets(pRExC_state, NULL, flagp, depth,
p++;
break;
case 'e':
- ender = ASCII_TO_NATIVE('\033');
+ ender = ESC_NATIVE;
p++;
break;
case 'a':
- ender = '\a';
+ ender = '\a';
p++;
break;
case 'o':
&& (PL_fold[ender] != PL_fold_latin1[ender]
|| ender == LATIN_SMALL_LETTER_SHARP_S
|| (len > 0
- && isARG2_lower_or_UPPER_ARG1('s', ender)
- && isARG2_lower_or_UPPER_ARG1('s',
- *(s-1)))))
+ && isALPHA_FOLD_EQ(ender, 's')
+ && isALPHA_FOLD_EQ(*(s-1), 's'))))
{
maybe_exactfu = FALSE;
}
* as if it turns into an EXACTFU, it could later get
* joined with another 's' that would then wrongly match
* the sharp s */
- if (maybe_exactfu && isARG2_lower_or_UPPER_ARG1('s', ender))
+ if (maybe_exactfu && isALPHA_FOLD_EQ(ender, 's'))
{
maybe_exactfu = FALSE;
}
}
/* Quit if are above what we should change */
- if (start > 255) {
+ if (start >= NUM_ANYOF_CODE_POINTS) {
break;
}
change_invlist = TRUE;
/* Set all the bits in the range, up to the max that we are doing */
- high = (end < 255) ? end : 255;
+ high = (end < NUM_ANYOF_CODE_POINTS - 1)
+ ? end
+ : NUM_ANYOF_CODE_POINTS - 1;
for (i = start; i <= (int) high; i++) {
if (! ANYOF_BITMAP_TEST(node, i)) {
ANYOF_BITMAP_SET(node, i);
* ignored in the recursion by means of a flag:
* <RExC_in_multi_char_class>.)
*
- * ANYOF nodes contain a bit map for the first 256 characters, with the
- * corresponding bit set if that character is in the list. For characters
- * above 255, a range list or swash is used. There are extra bits for \w,
- * etc. in locale ANYOFs, as what these match is not determinable at
- * compile time
+ * ANYOF nodes contain a bit map for the first NUM_ANYOF_CODE_POINTS
+ * characters, with the corresponding bit set if that character is in the
+ * list. For characters above this, a range list or swash is used. There
+ * are extra bits for \w, etc. in locale ANYOFs, as what these match is not
+ * determinable at compile time
*
* Returns NULL, setting *flagp to RESTART_UTF8 if the sizing scan needs
* to be restarted. This can only happen if ret_invlist is non-NULL.
{
namedclass = regpposixcc(pRExC_state, value, strict);
}
- else if (value == '\\') {
- if (UTF) {
+ else if (value != '\\') {
+#ifdef EBCDIC
+ literal_endpoint++;
+#endif
+ }
+ else {
+ /* Is a backslash; get the code point of the char after it */
+ if (UTF && ! UTF8_IS_INVARIANT(RExC_parse)) {
value = utf8n_to_uvchr((U8*)RExC_parse,
RExC_end - RExC_parse,
&numlen, UTF8_ALLOW_DEFAULT);
case 't': value = '\t'; break;
case 'f': value = '\f'; break;
case 'b': value = '\b'; break;
- case 'e': value = ASCII_TO_NATIVE('\033');break;
+ case 'e': value = ESC_NATIVE; break;
case 'a': value = '\a'; break;
case 'o':
RExC_parse--; /* function expects to be pointed at the 'o' */
break;
} /* End of switch on char following backslash */
} /* end of handling backslash escape sequences */
-#ifdef EBCDIC
- else
- literal_endpoint++;
-#endif
/* Here, we have the current token in 'value' */
swash = NULL;
}
+ /* Note that the optimization of using 'swash' if it is the only thing in
+ * the class doesn't have us change swash at all, so it can include things
+ * that are also in the bitmap; otherwise we have purposely deleted that
+ * duplicate information */
set_ANYOF_arg(pRExC_state, ret, cp_list,
(HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION)
? listsv : NULL,
}
}
+#if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
+SV *
+Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog,
+ const regnode* node,
+ bool doinit,
+ SV** listsvp,
+ SV** only_utf8_locale_ptr,
+ SV* exclude_list)
+
+{
+ /* For internal core use only.
+ * Returns the swash for the input 'node' in the regex 'prog'.
+ * If <doinit> is 'true', will attempt to create the swash if not already
+ * done.
+ * If <listsvp> is non-null, will return the printable contents of the
+ * swash. This can be used to get debugging information even before the
+ * swash exists, by calling this function with 'doinit' set to false, in
+ * which case the components that will be used to eventually create the
+ * swash are returned (in a printable form).
+ * If <exclude_list> is not NULL, it is an inversion list of things to
+ * exclude from what's returned in <listsvp>.
+ * Tied intimately to how S_set_ANYOF_arg sets up the data structure. Note
+ * that, in spite of this function's name, the swash it returns may include
+ * the bitmap data as well */
+
+ SV *sw = NULL;
+ SV *si = NULL; /* Input swash initialization string */
+ SV* invlist = NULL;
+
+ RXi_GET_DECL(prog,progi);
+ const struct reg_data * const data = prog ? progi->data : NULL;
+
+ PERL_ARGS_ASSERT__GET_REGCLASS_NONBITMAP_DATA;
+
+ assert(ANYOF_FLAGS(node)
+ & (ANYOF_UTF8|ANYOF_NONBITMAP_NON_UTF8|ANYOF_LOC_FOLD));
+
+ if (data && data->count) {
+ const U32 n = ARG(node);
+
+ if (data->what[n] == 's') {
+ SV * const rv = MUTABLE_SV(data->data[n]);
+ AV * const av = MUTABLE_AV(SvRV(rv));
+ SV **const ary = AvARRAY(av);
+ U8 swash_init_flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
+
+ si = *ary; /* ary[0] = the string to initialize the swash with */
+
+ /* Elements 3 and 4 are either both present or both absent. [3] is
+ * any inversion list generated at compile time; [4] indicates if
+ * that inversion list has any user-defined properties in it. */
+ if (av_tindex(av) >= 2) {
+ if (only_utf8_locale_ptr
+ && ary[2]
+ && ary[2] != &PL_sv_undef)
+ {
+ *only_utf8_locale_ptr = ary[2];
+ }
+ else {
+ assert(only_utf8_locale_ptr);
+ *only_utf8_locale_ptr = NULL;
+ }
+
+ if (av_tindex(av) >= 3) {
+ invlist = ary[3];
+ if (SvUV(ary[4])) {
+ swash_init_flags |= _CORE_SWASH_INIT_USER_DEFINED_PROPERTY;
+ }
+ }
+ else {
+ invlist = NULL;
+ }
+ }
+
+ /* Element [1] is reserved for the set-up swash. If already there,
+ * return it; if not, create it and store it there */
+ if (ary[1] && SvROK(ary[1])) {
+ sw = ary[1];
+ }
+ else if (doinit && ((si && si != &PL_sv_undef)
+ || (invlist && invlist != &PL_sv_undef))) {
+ assert(si);
+ sw = _core_swash_init("utf8", /* the utf8 package */
+ "", /* nameless */
+ si,
+ 1, /* binary */
+ 0, /* not from tr/// */
+ invlist,
+ &swash_init_flags);
+ (void)av_store(av, 1, sw);
+ }
+ }
+ }
+
+ /* If requested, return a printable version of what this swash matches */
+ if (listsvp) {
+ SV* matches_string = newSVpvs("");
+
+ /* The swash should be used, if possible, to get the data, as it
+ * contains the resolved data. But this function can be called at
+ * compile-time, before everything gets resolved, in which case we
+ * return the currently best available information, which is the string
+ * that will eventually be used to do that resolving, 'si' */
+ if ((! sw || (invlist = _get_swash_invlist(sw)) == NULL)
+ && (si && si != &PL_sv_undef))
+ {
+ sv_catsv(matches_string, si);
+ }
+
+ /* Add the inversion list to whatever we have. This may have come from
+ * the swash, or from an input parameter */
+ if (invlist) {
+ if (exclude_list) {
+ SV* clone = invlist_clone(invlist);
+ _invlist_subtract(clone, exclude_list, &clone);
+ sv_catsv(matches_string, _invlist_contents(clone));
+ SvREFCNT_dec_NN(clone);
+ }
+ else {
+ sv_catsv(matches_string, _invlist_contents(invlist));
+ }
+ }
+ *listsvp = matches_string;
+ }
+
+ return sw;
+}
+#endif /* !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION) */
/* reg_skipcomment()
);
if ( IS_ANYOF_TRIE(op) || trie->bitmap ) {
sv_catpvs(sv, "[");
- (void) put_latin1_charclass_innards(sv, IS_ANYOF_TRIE(op)
- ? ANYOF_BITMAP(o)
- : TRIE_BITMAP(trie));
+ (void) put_charclass_bitmap_innards(sv,
+ (IS_ANYOF_TRIE(op))
+ ? ANYOF_BITMAP(o)
+ : TRIE_BITMAP(trie),
+ NULL);
sv_catpvs(sv, "]");
}
else if (k == ANYOF) {
const U8 flags = ANYOF_FLAGS(o);
int do_sep = 0;
+ SV* bitmap_invlist; /* Will hold what the bit map contains */
if (flags & ANYOF_LOCALE_FLAGS)
if (flags & ANYOF_INVERT)
sv_catpvs(sv, "^");
- /* output what the standard cp 0-255 bitmap matches */
- do_sep = put_latin1_charclass_innards(sv, ANYOF_BITMAP(o));
+ /* output what the standard cp 0-NUM_ANYOF_CODE_POINTS-1 bitmap matches
+ * */
+ do_sep = put_charclass_bitmap_innards(sv, ANYOF_BITMAP(o),
+ &bitmap_invlist);
/* output any special charclass tests (used entirely under use
* locale) * */
been output */
SV *only_utf8_locale;
- /* Get the stuff that wasn't in the bitmap */
+ /* Get the stuff that wasn't in the bitmap. 'bitmap_invlist'
+ * is used to guarantee that nothing in the bitmap gets
+ * returned */
(void) _get_regclass_nonbitmap_data(prog, o, FALSE,
- &lv, &only_utf8_locale);
+ &lv, &only_utf8_locale,
+ bitmap_invlist);
if (lv && lv != &PL_sv_undef) {
char *s = savesvpv(lv);
char * const origs = s;
invlist_iterinit(only_utf8_locale);
while (invlist_iternext(only_utf8_locale,
&start, &end)) {
- put_range(sv, start, end);
+ put_range(sv, start, end, FALSE);
max_entries --;
if (max_entries < 0) {
sv_catpvs(sv, "...");
}
}
}
+ SvREFCNT_dec(bitmap_invlist);
+
Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
}
#ifdef DEBUGGING
+/* Given that c is a control character, is it one for which we have a
+ * mnemonic? */
+#define isMNEMONIC_CNTRL(c) ((isSPACE_A(c) && (c) != '\v') \
+ || (c) == '\a' \
+ || (c) == '\b' \
+ || (c) == ESC_NATIVE)
+/* Certain characters are output as a sequence with the first being a
+ * backslash. */
+#define isBACKSLASHED_PUNCT(c) \
+ ((c) == '-' || (c) == ']' || (c) == '\\' || (c) == '^')
+
STATIC void
S_put_byte(pTHX_ SV *sv, int c)
{
if (!isPRINT(c)) {
switch (c) {
- case '\r': Perl_sv_catpvf(aTHX_ sv, "\\r"); break;
+ case '\a': Perl_sv_catpvf(aTHX_ sv, "\\a"); break;
+ case '\b': Perl_sv_catpvf(aTHX_ sv, "\\b"); break;
+ case ESC_NATIVE: Perl_sv_catpvf(aTHX_ sv, "\\e"); break;
+ case '\f': Perl_sv_catpvf(aTHX_ sv, "\\f"); break;
case '\n': Perl_sv_catpvf(aTHX_ sv, "\\n"); break;
+ case '\r': Perl_sv_catpvf(aTHX_ sv, "\\r"); break;
case '\t': Perl_sv_catpvf(aTHX_ sv, "\\t"); break;
- case '\f': Perl_sv_catpvf(aTHX_ sv, "\\f"); break;
- case '\a': Perl_sv_catpvf(aTHX_ sv, "\\a"); break;
-
- default:
- Perl_sv_catpvf(aTHX_ sv, "\\x{%x}", c);
- break;
+ default: Perl_sv_catpvf(aTHX_ sv, "\\x{%02X}", c); break;
}
}
else {
const char string = c;
- if (c == '-' || c == ']' || c == '\\' || c == '^')
+ if (isBACKSLASHED_PUNCT(c))
sv_catpvs(sv, "\\");
sv_catpvn(sv, &string, 1);
}
}
+#define MAX_PRINT_A MAX_PRINT_A_FOR_USE_ONLY_BY_REGCOMP_DOT_C
+
+#ifndef MIN
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+#endif
+
STATIC void
-S_put_range(pTHX_ SV *sv, UV start, UV end)
+S_put_range(pTHX_ SV *sv, UV start, const UV end, const bool allow_literals)
{
-
/* Appends to 'sv' a displayable version of the range of code points from
* 'start' to 'end'. It assumes that only ASCII printables are displayable
- * as-is (though some of these will be escaped by put_byte()). For the
- * time being, this subroutine only works for latin1 (< 256) code points */
+ * as-is (though some of these will be escaped by put_byte()). */
+
+ const unsigned int min_range_count = 3;
assert(start <= end);
PERL_ARGS_ASSERT_PUT_RANGE;
while (start <= end) {
- if (end - start < 3) { /* Individual chars in short ranges */
+ if (end - start < min_range_count) {
+
+ /* Individual chars in short ranges */
for (; start <= end; start++) {
put_byte(sv, start);
}
break;
}
- /* For small ranges that include printable ASCII characters, it's more
- * legible to print those characters rather than hex values. For
- * larger ranges that include more than printables, it's probably
- * clearer to just give the start and end points of the range in hex,
- * and that's all we can do if there aren't any printables within the
- * range
- *
- * On ASCII platforms the range of printables is contiguous. If the
- * entire range is printable, we print each character as such. If the
- * range is partially printable and partially not, it's less likely
- * that the individual printables are meaningful, especially if all or
- * almost all of them are in the range. But we err on the side of the
- * individual printables being meaningful by using the hex only if the
- * range contains all but 2 of the printables.
- *
- * On EBCDIC platforms, the printables are scattered around so that the
- * maximum range length containing only them is about 10. Anything
- * longer we treat as hex; otherwise we examine the range character by
- * character to see */
-#ifdef EBCDIC
- if (start < 256 && (((end < 255) ? end : 255) - start <= 10))
-#else
- if ((isPRINT_A(start) && isPRINT_A(end))
- || (end >= 0x7F && (isPRINT_A(start) && start > 0x21))
- || ((end < 0x7D && isPRINT_A(end)) && start < 0x20))
-#endif
- {
- /* If the range beginning isn't an ASCII printable, we find the
- * last such in the range, then split the output, so all the
- * non-printables are in one subrange; then process the remaining
- * portion as usual. If the entire range isn't printables, we
- * don't split, but drop down to print as hex */
+ /* If permitted by the input options, and there is a possibility that
+ * this range contains a printable literal, look to see if there is
+ * one. */
+ if (allow_literals && start <= MAX_PRINT_A) {
+
+ /* If the range begin isn't an ASCII printable, effectively split
+ * the range into two parts:
+ * 1) the portion before the first such printable,
+ * 2) the rest
+ * and output them separately. */
if (! isPRINT_A(start)) {
UV temp_end = start + 1;
- while (temp_end <= end && ! isPRINT_A(temp_end)) {
+
+ /* There is no point looking beyond the final possible
+ * printable, in MAX_PRINT_A */
+ UV max = MIN(end, MAX_PRINT_A);
+
+ while (temp_end <= max && ! isPRINT_A(temp_end)) {
temp_end++;
}
- if (temp_end <= end) {
- put_range(sv, start, temp_end - 1);
- start = temp_end;
- continue;
+
+ /* Here, temp_end points to one beyond the first printable if
+ * found, or to one beyond 'max' if not. If none found, make
+ * sure that we use the entire range */
+ if (temp_end > MAX_PRINT_A) {
+ temp_end = end + 1;
}
- }
- /* If the range beginning is a digit, output a subrange of just the
- * digits, then process the remaining portion as usual */
- if (isDIGIT_A(start)) {
- put_byte(sv, start);
- sv_catpvs(sv, "-");
- while (start <= end && isDIGIT_A(start)) start++;
- put_byte(sv, start - 1);
+ /* Output the first part of the split range, the part that
+ * doesn't have printables, with no looking for literals
+ * (otherwise we would infinitely recurse) */
+ put_range(sv, start, temp_end - 1, FALSE);
+
+ /* The 2nd part of the range (if any) starts here. */
+ start = temp_end;
+
+ /* We continue instead of dropping down because even if the 2nd
+ * part is non-empty, it could be so short that we want to
+ * output it specially, as tested for at the top of this loop.
+ * */
continue;
}
- /* Similarly for alphabetics. Because in both ASCII and EBCDIC,
- * the code points for upper and lower A-Z and a-z aren't
- * intermixed, the resulting subrange will consist solely of either
- * upper- or lower- alphabetics */
- if (isALPHA_A(start)) {
- put_byte(sv, start);
- sv_catpvs(sv, "-");
- while (start <= end && isALPHA_A(start)) start++;
- put_byte(sv, start - 1);
+ /* Here, 'start' is a printable ASCII. If it is an alphanumeric,
+ * output a sub-range of just the digits or letters, then process
+ * the remaining portion as usual. */
+ if (isALPHANUMERIC_A(start)) {
+ UV mask = (isDIGIT_A(start))
+ ? _CC_DIGIT
+ : isUPPER_A(start)
+ ? _CC_UPPER
+ : _CC_LOWER;
+ UV temp_end = start + 1;
+
+ /* Find the end of the sub-range that includes just the
+ * characters in the same class as the first character in it */
+ while (temp_end <= end && _generic_isCC_A(temp_end, mask)) {
+ temp_end++;
+ }
+ temp_end--;
+
+ /* For short ranges, don't duplicate the code above to output
+ * them; just call recursively */
+ if (temp_end - start < min_range_count) {
+ put_range(sv, start, temp_end, FALSE);
+ }
+ else { /* Output as a range */
+ put_byte(sv, start);
+ sv_catpvs(sv, "-");
+ put_byte(sv, temp_end);
+ }
+ start = temp_end + 1;
continue;
}
- /* We output any remaining printables as individual characters */
+ /* We output any other printables as individual characters */
if (isPUNCT_A(start) || isSPACE_A(start)) {
- while (start <= end && (isPUNCT_A(start) || isSPACE_A(start))) {
+ while (start <= end && (isPUNCT_A(start)
+ || isSPACE_A(start)))
+ {
put_byte(sv, start);
start++;
}
continue;
}
+ } /* End of looking for literals */
+
+ /* Here is not to output as a literal. Some control characters have
+ * mnemonic names. Split off any of those at the beginning and end of
+ * the range to print mnemonically. It isn't possible for many of
+ * these to be in a row, so this won't overwhelm with output */
+ if (isMNEMONIC_CNTRL(start)) {
+ while (isMNEMONIC_CNTRL(start) && start <= end) {
+ put_byte(sv, start);
+ start++;
+ }
+ }
+ if (start < end && isMNEMONIC_CNTRL(end)) {
+
+ /* Here, the final character in the range has a mnemonic name.
+ * Work backwards from the end to find the final non-mnemonic */
+ UV temp_end = end - 1;
+ while (isMNEMONIC_CNTRL(temp_end)) {
+ temp_end--;
+ }
+
+ /* And separately output the range that doesn't have mnemonics */
+ put_range(sv, start, temp_end, FALSE);
+
+ /* Then output the mnemonic trailing controls */
+ start = temp_end + 1;
+ while (start <= end) {
+ put_byte(sv, start);
+ start++;
+ }
+ break;
}
- /* Here is a control or non-ascii. Output the range or subrange as
- * hex. */
+ /* As a final resort, output the range or subrange as hex. */
Perl_sv_catpvf(aTHX_ sv, "\\x{%02" UVXf "}-\\x{%02" UVXf "}",
start,
- (end < 256) ? end : 255);
+ (end < NUM_ANYOF_CODE_POINTS)
+ ? end
+ : NUM_ANYOF_CODE_POINTS - 1);
break;
}
}
STATIC bool
-S_put_latin1_charclass_innards(pTHX_ SV *sv, char *bitmap)
+S_put_charclass_bitmap_innards(pTHX_ SV *sv, char *bitmap, SV** bitmap_invlist)
{
/* Appends to 'sv' a displayable version of the innards of the bracketed
* character class whose bitmap is 'bitmap'; Returns 'TRUE' if it actually
- * output anything */
+ * output anything, and bitmap_invlist, if not NULL, will point to an
+ * inversion list of what is in the bit map */
int i;
- bool has_output_anything = FALSE;
+ UV start, end;
+ unsigned int punct_count = 0;
+ SV* invlist = NULL;
+ SV** invlist_ptr; /* Temporary, in case bitmap_invlist is NULL */
+ bool allow_literals = TRUE;
- PERL_ARGS_ASSERT_PUT_LATIN1_CHARCLASS_INNARDS;
+ PERL_ARGS_ASSERT_PUT_CHARCLASS_BITMAP_INNARDS;
- for (i = 0; i < 256; i++) {
- if (BITMAP_TEST((U8 *) bitmap,i)) {
+ invlist_ptr = (bitmap_invlist) ? bitmap_invlist : &invlist;
- /* The character at index i should be output. Find the next
- * character that should NOT be output */
- int j;
- for (j = i + 1; j < 256; j++) {
- if (! BITMAP_TEST((U8 *) bitmap, j)) {
- break;
+ /* Worst case is exactly every-other code point is in the list */
+ *invlist_ptr = _new_invlist(NUM_ANYOF_CODE_POINTS / 2);
+
+ /* Convert the bit map to an inversion list, keeping track of how many
+ * ASCII puncts are set, including an extra amount for the backslashed
+ * ones. */
+ for (i = 0; i < NUM_ANYOF_CODE_POINTS; i++) {
+ if (BITMAP_TEST((U8 *) bitmap,i)) {
+ *invlist_ptr = add_cp_to_invlist(*invlist_ptr, i);
+ if (isPUNCT_A(i)) {
+ punct_count++;
+ if isBACKSLASHED_PUNCT(i) {
+ punct_count++;
}
}
+ }
+ }
+
+ /* Nothing to output */
+ if (_invlist_len(*invlist_ptr) == 0) {
+ SvREFCNT_dec(invlist);
+ return FALSE;
+ }
+
+ /* Generally, it is more readable if printable characters are output as
+ * literals, but if a range (nearly) spans all of them, it's best to output
+ * it as a single range. This code will use a single range if all but 2
+ * printables are in it */
+ invlist_iterinit(*invlist_ptr);
+ while (invlist_iternext(*invlist_ptr, &start, &end)) {
+
+ /* If range starts beyond final printable, it doesn't have any in it */
+ if (start > MAX_PRINT_A) {
+ break;
+ }
- /* Everything between them is a single range that should be output
- * */
- put_range(sv, i, j - 1);
- has_output_anything = TRUE;
- i = j;
+ /* In both ASCII and EBCDIC, a SPACE is the lowest printable. To span
+ * all but two, the range must start and end no later than 2 from
+ * either end */
+ if (start < ' ' + 2 && end > MAX_PRINT_A - 2) {
+ if (end > MAX_PRINT_A) {
+ end = MAX_PRINT_A;
+ }
+ if (start < ' ') {
+ start = ' ';
+ }
+ if (end - start >= MAX_PRINT_A - ' ' - 2) {
+ allow_literals = FALSE;
+ }
+ break;
}
}
+ invlist_iterfinish(*invlist_ptr);
+
+ /* The legibility of the output depends mostly on how many punctuation
+ * characters are output. There are 32 possible ASCII ones, and some have
+ * an additional backslash, bringing it to currently 36, so if any more
+ * than 18 are to be output, we can instead output it as its complement,
+ * yielding fewer puncts, and making it more legible. But give some weight
+ * to the fact that outputting it as a complement is less legible than a
+ * straight output, so don't complement unless we are somewhat over the 18
+ * mark */
+ if (allow_literals && punct_count > 22) {
+ sv_catpvs(sv, "^");
+
+ /* Add everything remaining to the list, so when we invert it just
+ * below, it will be excluded */
+ *invlist_ptr = _add_range_to_invlist(*invlist_ptr,
+ NUM_ANYOF_CODE_POINTS, UV_MAX);
+ _invlist_invert(*invlist_ptr);
+ }
+
+ /* Here we have figured things out. Output each range */
+ invlist_iterinit(*invlist_ptr);
+ while (invlist_iternext(*invlist_ptr, &start, &end)) {
+ if (start >= NUM_ANYOF_CODE_POINTS) {
+ break;
+ }
+ put_range(sv, start, end, allow_literals);
+ }
+ invlist_iterfinish(*invlist_ptr);
- return has_output_anything;
+ return TRUE;
}
#define CLEAR_OPTSTART \