3 # Copyright (C) 1998, 1999 Tom Tromey
4 # Copyright (C) 2001 Red Hat Software
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2, or (at your option)
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
21 # gen-casemap-test.pl - Generate test cases for case mapping from Unicode data.
22 # See http://www.unicode.org/Public/UNIDATA/UnicodeCharacterDatabase.html
23 # I consider the output of this program to be unrestricted. Use it as
30 die "Usage: $0 UNICODE-VERSION UnicodeData.txt SpecialCasing.txt\n";
33 use vars qw($CODE $NAME $CATEGORY $COMBINING_CLASSES $BIDI_CATEGORY $DECOMPOSITION $DECIMAL_VALUE $DIGIT_VALUE $NUMERIC_VALUE $MIRRORED $OLD_NAME $COMMENT $UPPER $LOWER $TITLE $BREAK_CODE $BREAK_CATEGORY $BREAK_NAME $CASE_CODE $CASE_LOWER $CASE_TITLE $CASE_UPPER $CASE_CONDITION);
35 # Names of fields in Unicode data table.
39 $COMBINING_CLASSES = 3;
52 # Names of fields in the SpecialCasing table
63 open (INPUT, "< $ARGV[1]") || exit 1;
69 @fields = split (';', $_, 30);
72 printf STDERR ("Entry for $fields[$CODE] has wrong number of fields (%d)\n", $#fields);
75 $code = hex ($fields[$CODE]);
77 last if ($code > 0xFFFF); # ignore characters out of the basic plane
79 if ($code > $last_code + 1)
82 if ($fields[$NAME] =~ /Last>/)
84 # Fill the gap with the last character read,
85 # since this was a range specified in the char database
90 # The gap represents undefined characters. Only the type
92 @gfields = ('', '', 'Cn', '0', '', '', '', '', '', '', '',
95 for (++$last_code; $last_code < $code; ++$last_code)
97 $gfields{$CODE} = sprintf ("%04x", $last_code);
98 &process_one ($last_code, @gfields);
101 &process_one ($code, @fields);
107 open (INPUT, "< $ARGV[2]") || exit 1;
120 @fields = split ('\s*;\s*', $_, 30);
122 $raw_code = $fields[$CASE_CODE];
123 $code = hex ($raw_code);
125 if ($#fields != 4 && $#fields != 5)
127 printf STDERR ("Entry for $raw_code has wrong number of fields (%d)\n", $#fields);
131 if (defined $fields[5]) {
132 # Ignore conditional special cases - we'll handle them manually
136 $upper[$code] = &make_hex ($fields[$CASE_UPPER]);
137 $lower[$code] = &make_hex ($fields[$CASE_LOWER]);
138 $title[$code] = &make_hex ($fields[$CASE_TITLE]);
144 # Test cases generated from Unicode $ARGV[0] data
145 # by gen-case-tests.pl. Do not edit.
147 # Some special hand crafted tests
149 tr_TR\ti\ti\t\x{0130}\t\x{0130}\t# i => LATIN CAPITAL LETTER I WITH DOT ABOVE
150 tr_TR\tI\t\x{0131}\tI\tI\t# I => LATIN SMALL LETTER DOTLESS I
151 # Test reordering of YPOGEGRAMMENI across other accents
152 \t\x{03b1}\x{0345}\x{0314}\t\x{03b1}\x{0345}\x{314}\t\x{0391}\x{0345}\x{0314}\t\x{0391}\x{0314}\x{0399}\t
153 \t\x{03b1}\x{0314}\x{0345}\t\x{03b1}\x{314}\x{0345}\t\x{0391}\x{0314}\x{0345}\t\x{0391}\x{0314}\x{0399}\t
154 # Handling of final and nonfinal sigma
155 ΜΆΙΟΣ μάιος Μάιος ΜΆΙΟΣ
156 ΜΆΙΟΣ μάιος Μάιος ΜΆΙΟΣ
157 ΣΙΓΜΑ σιγμα Σιγμα ΣΙΓΜΑ
158 # Lithuanian rule of i followed by letter with dot. Not at all sure
159 # about the titlecase part here
160 lt_LT\ti\x{117}\ti\x{117}\tIe\tIE\t
161 lt_LT\tie\x{307}\tie\x{307}\tIe\tIE\t
163 # Now the automatic tests
170 # Process a single character.
173 my ($code, @fields) = @_;
175 my $type = $fields[$CATEGORY];
178 $upper[$code] = make_hex ($fields[$UPPER]);
179 $lower[$code] = pack ("U", $code);
180 $title[$code] = make_hex ($fields[$TITLE]);
182 elsif ($type eq 'Lu')
184 $lower[$code] = make_hex ($fields[$LOWER]);
185 $upper[$code] = pack ("U", $code);
186 $title[$code] = make_hex ($fields[$TITLE]);
191 $upper[$code] = make_hex ($fields[$UPPER]);
192 $lower[$code] = pack ("U", hex ($fields[$LOWER]));
193 $title[$code] = make_hex ($fields[$LOWER]);
199 for ($i = 0; $i < 0xffff; $i++) {
201 # Greek sigma needs special tests
205 my $lower = $lower[$i];
206 my $title = $title[$i];
207 my $upper = $upper[$i];
209 if (defined $upper || defined $lower || defined $title) {
210 printf "\t%s\t%s\t%s\t%s\t# %4X\n",
212 (defined $lower ? $lower : ""),
213 (defined $title ? $title : ""),
214 (defined $upper ? $upper : ""),
227 if ($codes eq "0" || $codes eq "") {
230 return pack ("U*", map { hex ($_) } split /\s+/, $codes);