Mercurial > repo
comparison perl-5.22.2/regen/regcharclass_multi_char_folds.pl @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
8044:711c038a7dce | 8045:a16537d2fe07 |
---|---|
1 package regcharclass_multi_char_folds; | |
2 use 5.015; | |
3 use strict; | |
4 use warnings; | |
5 use Unicode::UCD "prop_invmap"; | |
6 | |
7 # This returns an array of strings of the form | |
8 # "\x{foo}\x{bar}\x{baz}" | |
9 # of the sequences of code points that are multi-character folds in the | |
10 # current Unicode version. If the parameter is 1, all such folds are | |
11 # returned. If the parameters is 0, only the ones containing exclusively | |
12 # Latin1 characters are returned. In the latter case all combinations of | |
13 # Latin1 characters that can fold to the base one are returned. Thus for | |
14 # 'ss', it would return in addition, 'Ss', 'sS', and 'SS'. This is because | |
15 # this code is designed to help regcomp.c, and EXACTFish regnodes. For | |
16 # non-UTF-8 patterns, the strings are not folded, so we need to check for the | |
17 # upper and lower case versions. For UTF-8 patterns, the strings are folded, | |
18 # except in EXACTFL nodes) so we only need to worry about the fold version. | |
19 # All folded-to characters in non-UTF-8 (Latin1) are members of fold-pairs, | |
20 # at least within Latin1, 'k', and 'K', for example. So there aren't | |
21 # complications with dealing with unfolded input. That's not true of UTF-8 | |
22 # patterns, where things can get tricky. Thus for EXACTFL nodes where things | |
23 # aren't all folded, code has to be written specially to handle this, instead | |
24 # of the macros here being extended to try to handle it. | |
25 # | |
26 # There are no non-ASCII Latin1 multi-char folds currently, and none likely to | |
27 # be ever added. Thus the output is the same as if it were just asking for | |
28 # ASCII characters, not full Latin1. Hence, it is suitable for generating | |
29 # things that match EXACTFA. It does check for and croak if there ever were | |
30 # to be an upper Latin1 range multi-character fold. | |
31 # | |
32 # This is designed for input to regen/regcharlass.pl. | |
33 | |
34 sub gen_combinations ($;) { | |
35 # Generate all combinations for the first parameter which is an array of | |
36 # arrays. | |
37 | |
38 my ($fold_ref, $string, $i) = @_; | |
39 $string = "" unless $string; | |
40 $i = 0 unless $i; | |
41 | |
42 my @ret; | |
43 | |
44 # Look at each element in this level's array. | |
45 foreach my $j (0 .. @{$fold_ref->[$i]} - 1) { | |
46 | |
47 # Append its representation to what we have currently | |
48 my $new_string = sprintf "$string\\x{%X}", $fold_ref->[$i][$j]; | |
49 | |
50 if ($i >= @$fold_ref - 1) { # Final level: just return it | |
51 push @ret, "\"$new_string\""; | |
52 } | |
53 else { # Generate the combinations for the next level with this one's | |
54 push @ret, &gen_combinations($fold_ref, $new_string, $i + 1); | |
55 } | |
56 } | |
57 | |
58 return @ret; | |
59 } | |
60 | |
61 sub multi_char_folds ($) { | |
62 my $all_folds = shift; # The single parameter is true if wants all | |
63 # multi-char folds; false if just the ones that | |
64 # are all ascii | |
65 | |
66 my ($cp_ref, $folds_ref, $format) = prop_invmap("Case_Folding"); | |
67 die "Could not find inversion map for Case_Folding" unless defined $format; | |
68 die "Incorrect format '$format' for Case_Folding inversion map" | |
69 unless $format eq 'al'; | |
70 my @folds; | |
71 | |
72 for my $i (0 .. @$folds_ref - 1) { | |
73 next unless ref $folds_ref->[$i]; # Skip single-char folds | |
74 | |
75 # The code in regcomp.c currently assumes that no multi-char fold | |
76 # folds to the upper Latin1 range. It's not a big deal to add; we | |
77 # just have to forbid such a fold in EXACTFL nodes, like we do already | |
78 # for ascii chars in EXACTFA (and EXACTFL) nodes. But I (khw) doubt | |
79 # that there will ever be such a fold created by Unicode, so the code | |
80 # isn't there to occupy space and time; instead there is this check. | |
81 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]}; | |
82 | |
83 # Create a line that looks like "\x{foo}\x{bar}\x{baz}" of the code | |
84 # points that make up the fold. | |
85 my $fold = join "", map { sprintf "\\x{%X}", $_ } @{$folds_ref->[$i]}; | |
86 $fold = "\"$fold\""; | |
87 | |
88 # Skip if something else already has this fold | |
89 next if grep { $_ eq $fold } @folds; | |
90 | |
91 if ($all_folds) { | |
92 push @folds, $fold | |
93 } # Skip if wants only all-ascii folds, and there is a non-ascii | |
94 elsif (! grep { chr($_) =~ /[^[:ascii:]]/ } @{$folds_ref->[$i]}) { | |
95 | |
96 # If the fold is to a cased letter, replace the entry with an | |
97 # array which also includes its upper case. | |
98 my $this_fold_ref = $folds_ref->[$i]; | |
99 for my $j (0 .. @$this_fold_ref - 1) { | |
100 my $this_ord = $this_fold_ref->[$j]; | |
101 if (chr($this_ord) =~ /\p{Cased}/) { | |
102 my $uc = ord(uc(chr($this_ord))); | |
103 undef $this_fold_ref->[$j]; | |
104 @{$this_fold_ref->[$j]} = ( $this_ord, $uc); | |
105 } | |
106 } | |
107 | |
108 # Then generate all combinations of upper/lower case of the fold. | |
109 push @folds, gen_combinations($this_fold_ref); | |
110 | |
111 } | |
112 } | |
113 | |
114 # \x17F is the small LONG S, which folds to 's'. Both Capital and small | |
115 # LATIN SHARP S fold to 'ss'. Therefore, they should also match two 17F's | |
116 # in a row under regex /i matching. But under /iaa regex matching, all | |
117 # three folds to 's' are prohibited, but the sharp S's should still match | |
118 # two 17F's. This prohibition causes our regular regex algorithm that | |
119 # would ordinarily allow this match to fail. This is the only instance in | |
120 # all Unicode of this kind of issue. By adding a special case here, we | |
121 # can use the regular algorithm (with some other changes elsewhere as | |
122 # well). | |
123 # | |
124 # It would be possible to re-write the above code to automatically detect | |
125 # and handle this case, and any others that might eventually get added to | |
126 # the Unicode standard, but I (khw) don't think it's worth it. I believe | |
127 # that it's extremely unlikely that more folds to ASCII characters are | |
128 # going to be added, and if I'm wrong, fold_grind.t has the intelligence | |
129 # to detect them, and test that they work, at which point another special | |
130 # case could be added here if necessary. | |
131 # | |
132 # No combinations of this with 's' need be added, as any of these | |
133 # containing 's' are prohibted under /iaa. | |
134 push @folds, '"\x{17F}\x{17F}"' if $all_folds; | |
135 | |
136 | |
137 return @folds; | |
138 } | |
139 | |
140 1 |