| 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 | return () if pack("C*", split /\./, Unicode::UCD::UnicodeVersion()) lt v3.0.1; |
| 67 | |
| 68 | my ($cp_ref, $folds_ref, $format) = prop_invmap("Case_Folding"); |
| 69 | die "Could not find inversion map for Case_Folding" unless defined $format; |
| 70 | die "Incorrect format '$format' for Case_Folding inversion map" |
| 71 | unless $format eq 'al'; |
| 72 | my @folds; |
| 73 | |
| 74 | for my $i (0 .. @$folds_ref - 1) { |
| 75 | next unless ref $folds_ref->[$i]; # Skip single-char folds |
| 76 | |
| 77 | # The code in regcomp.c currently assumes that no multi-char fold |
| 78 | # folds to the upper Latin1 range. It's not a big deal to add; we |
| 79 | # just have to forbid such a fold in EXACTFL nodes, like we do already |
| 80 | # for ascii chars in EXACTFA (and EXACTFL) nodes. But I (khw) doubt |
| 81 | # that there will ever be such a fold created by Unicode, so the code |
| 82 | # isn't there to occupy space and time; instead there is this check. |
| 83 | 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]}; |
| 84 | |
| 85 | # Create a line that looks like "\x{foo}\x{bar}\x{baz}" of the code |
| 86 | # points that make up the fold. |
| 87 | my $fold = join "", map { sprintf "\\x{%X}", $_ } @{$folds_ref->[$i]}; |
| 88 | $fold = "\"$fold\""; |
| 89 | |
| 90 | # Skip if something else already has this fold |
| 91 | next if grep { $_ eq $fold } @folds; |
| 92 | |
| 93 | if ($all_folds) { |
| 94 | push @folds, $fold |
| 95 | } # Skip if wants only all-ascii folds, and there is a non-ascii |
| 96 | elsif (! grep { chr($_) =~ /[^[:ascii:]]/ } @{$folds_ref->[$i]}) { |
| 97 | |
| 98 | # If the fold is to a cased letter, replace the entry with an |
| 99 | # array which also includes its upper case. |
| 100 | my $this_fold_ref = $folds_ref->[$i]; |
| 101 | for my $j (0 .. @$this_fold_ref - 1) { |
| 102 | my $this_ord = $this_fold_ref->[$j]; |
| 103 | if (chr($this_ord) =~ /\p{Cased}/) { |
| 104 | my $uc = ord(uc(chr($this_ord))); |
| 105 | undef $this_fold_ref->[$j]; |
| 106 | @{$this_fold_ref->[$j]} = ( $this_ord, $uc); |
| 107 | } |
| 108 | } |
| 109 | |
| 110 | # Then generate all combinations of upper/lower case of the fold. |
| 111 | push @folds, gen_combinations($this_fold_ref); |
| 112 | |
| 113 | } |
| 114 | } |
| 115 | |
| 116 | # \x17F is the small LONG S, which folds to 's'. Both Capital and small |
| 117 | # LATIN SHARP S fold to 'ss'. Therefore, they should also match two 17F's |
| 118 | # in a row under regex /i matching. But under /iaa regex matching, all |
| 119 | # three folds to 's' are prohibited, but the sharp S's should still match |
| 120 | # two 17F's. This prohibition causes our regular regex algorithm that |
| 121 | # would ordinarily allow this match to fail. This is the only instance in |
| 122 | # all Unicode of this kind of issue. By adding a special case here, we |
| 123 | # can use the regular algorithm (with some other changes elsewhere as |
| 124 | # well). |
| 125 | # |
| 126 | # It would be possible to re-write the above code to automatically detect |
| 127 | # and handle this case, and any others that might eventually get added to |
| 128 | # the Unicode standard, but I (khw) don't think it's worth it. I believe |
| 129 | # that it's extremely unlikely that more folds to ASCII characters are |
| 130 | # going to be added, and if I'm wrong, fold_grind.t has the intelligence |
| 131 | # to detect them, and test that they work, at which point another special |
| 132 | # case could be added here if necessary. |
| 133 | # |
| 134 | # No combinations of this with 's' need be added, as any of these |
| 135 | # containing 's' are prohibted under /iaa. |
| 136 | push @folds, '"\x{17F}\x{17F}"' if $all_folds; |
| 137 | |
| 138 | |
| 139 | return @folds; |
| 140 | } |
| 141 | |
| 142 | 1 |