File: regcharclass_multi_char_folds.pl

package info (click to toggle)
perl 5.24.1-3+deb9u5
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 103,716 kB
  • sloc: perl: 559,611; ansic: 293,886; sh: 67,316; pascal: 7,632; cpp: 3,895; makefile: 2,436; xml: 2,410; yacc: 989; sed: 6; lisp: 1
file content (142 lines) | stat: -rw-r--r-- 6,498 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
package regcharclass_multi_char_folds;
use 5.015;
use strict;
use warnings;
use Unicode::UCD "prop_invmap";

# This returns an array of strings of the form
#   "\x{foo}\x{bar}\x{baz}"
# of the sequences of code points that are multi-character folds in the
# current Unicode version.  If the parameter is 1, all such folds are
# returned.  If the parameters is 0, only the ones containing exclusively
# Latin1 characters are returned.  In the latter case all combinations of
# Latin1 characters that can fold to the base one are returned.  Thus for
# 'ss', it would return in addition, 'Ss', 'sS', and 'SS'.  This is because
# this code is designed to help regcomp.c, and EXACTFish regnodes.  For
# non-UTF-8 patterns, the strings are not folded, so we need to check for the
# upper and lower case versions.  For UTF-8 patterns, the strings are folded,
# except in EXACTFL nodes) so we only need to worry about the fold version.
# All folded-to characters in non-UTF-8 (Latin1) are members of fold-pairs,
# at least within Latin1, 'k', and 'K', for example.  So there aren't
# complications with dealing with unfolded input.  That's not true of UTF-8
# patterns, where things can get tricky.  Thus for EXACTFL nodes where things
# aren't all folded, code has to be written specially to handle this, instead
# of the macros here being extended to try to handle it.
#
# There are no non-ASCII Latin1 multi-char folds currently, and none likely to
# be ever added.  Thus the output is the same as if it were just asking for
# ASCII characters, not full Latin1.  Hence, it is suitable for generating
# things that match EXACTFA.  It does check for and croak if there ever were
# to be an upper Latin1 range multi-character fold.
#
# This is designed for input to regen/regcharlass.pl.

sub gen_combinations ($;) {
    # Generate all combinations for the first parameter which is an array of
    # arrays.

    my ($fold_ref, $string, $i) = @_;
    $string = "" unless $string;
    $i = 0 unless $i;

    my @ret;

    # Look at each element in this level's array.
    foreach my $j (0 .. @{$fold_ref->[$i]} - 1) {

        # Append its representation to what we have currently
        my $new_string = sprintf "$string\\x{%X}", $fold_ref->[$i][$j];

        if ($i >=  @$fold_ref - 1) {    # Final level: just return it
            push @ret, "\"$new_string\"";
        }
        else {  # Generate the combinations for the next level with this one's
            push @ret, &gen_combinations($fold_ref, $new_string, $i + 1);
        }
    }

    return @ret;
}

sub multi_char_folds ($) {
    my $all_folds = shift;  # The single parameter is true if wants all
                            # multi-char folds; false if just the ones that
                            # are all ascii

    return () if pack("C*", split /\./, Unicode::UCD::UnicodeVersion()) lt v3.0.1;

    my ($cp_ref, $folds_ref, $format) = prop_invmap("Case_Folding");
    die "Could not find inversion map for Case_Folding" unless defined $format;
    die "Incorrect format '$format' for Case_Folding inversion map"
                                                        unless $format eq 'al';
    my @folds;

    for my $i (0 .. @$folds_ref - 1) {
        next unless ref $folds_ref->[$i];   # Skip single-char folds

        # The code in regcomp.c currently assumes that no multi-char fold
        # folds to the upper Latin1 range.  It's not a big deal to add; we
        # just have to forbid such a fold in EXACTFL nodes, like we do already
        # for ascii chars in EXACTFA (and EXACTFL) nodes.  But I (khw) doubt
        # that there will ever be such a fold created by Unicode, so the code
        # isn't there to occupy space and time; instead there is this check.
        die sprintf("regcomp.c can't cope with a latin1 multi-char fold (found in the fold of 0x%X", $cp_ref->[$i]) if grep { $_ < 256 && chr($_) !~ /[[:ascii:]]/ } @{$folds_ref->[$i]};

        # Create a line that looks like "\x{foo}\x{bar}\x{baz}" of the code
        # points that make up the fold.
        my $fold = join "", map { sprintf "\\x{%X}", $_ } @{$folds_ref->[$i]};
        $fold = "\"$fold\"";

        # Skip if something else already has this fold
        next if grep { $_ eq $fold } @folds;

        if ($all_folds) {
            push @folds, $fold
        }   # Skip if wants only all-ascii folds, and there is a non-ascii
        elsif (! grep { chr($_) =~ /[^[:ascii:]]/ } @{$folds_ref->[$i]}) {

            # If the fold is to a cased letter, replace the entry with an
            # array which also includes its upper case.
            my $this_fold_ref = $folds_ref->[$i];
            for my $j (0 .. @$this_fold_ref - 1) {
                my $this_ord = $this_fold_ref->[$j];
                if (chr($this_ord) =~ /\p{Cased}/) {
                    my $uc = ord(uc(chr($this_ord)));
                    undef $this_fold_ref->[$j];
                    @{$this_fold_ref->[$j]} = ( $this_ord, $uc);
                }
            }

            # Then generate all combinations of upper/lower case of the fold.
            push @folds, gen_combinations($this_fold_ref);

        }
    }

    # \x17F is the small LONG S, which folds to 's'.  Both Capital and small
    # LATIN SHARP S fold to 'ss'.  Therefore, they should also match two 17F's
    # in a row under regex /i matching.  But under /iaa regex matching, all
    # three folds to 's' are prohibited, but the sharp S's should still match
    # two 17F's.  This prohibition causes our regular regex algorithm that
    # would ordinarily allow this match to fail.  This is the only instance in
    # all Unicode of this kind of issue.  By adding a special case here, we
    # can use the regular algorithm (with some other changes elsewhere as
    # well).
    #
    # It would be possible to re-write the above code to automatically detect
    # and handle this case, and any others that might eventually get added to
    # the Unicode standard, but I (khw) don't think it's worth it.  I believe
    # that it's extremely unlikely that more folds to ASCII characters are
    # going to be added, and if I'm wrong, fold_grind.t has the intelligence
    # to detect them, and test that they work, at which point another special
    # case could be added here if necessary.
    #
    # No combinations of this with 's' need be added, as any of these
    # containing 's' are prohibted under /iaa.
    push @folds, '"\x{17F}\x{17F}"' if $all_folds;


    return @folds;
}

1