diff options
Diffstat (limited to 'Build/source/libs/icu/icu-4.4/tools/genpname/preparse.pl')
-rwxr-xr-x | Build/source/libs/icu/icu-4.4/tools/genpname/preparse.pl | 1328 |
1 files changed, 0 insertions, 1328 deletions
diff --git a/Build/source/libs/icu/icu-4.4/tools/genpname/preparse.pl b/Build/source/libs/icu/icu-4.4/tools/genpname/preparse.pl deleted file mode 100755 index bb4fcfefa11..00000000000 --- a/Build/source/libs/icu/icu-4.4/tools/genpname/preparse.pl +++ /dev/null @@ -1,1328 +0,0 @@ -#!/bin/perl -w -#******************************************************************* -# COPYRIGHT: -# Copyright (c) 2002-2009, International Business Machines Corporation and -# others. All Rights Reserved. -#******************************************************************* - -# This script reads in UCD files PropertyAliases.txt and -# PropertyValueAliases.txt and correlates them with ICU enums -# defined in uchar.h and uscript.h. It then outputs a header -# file which contains all names and enums. The header is included -# by the genpname tool C++ source file, which produces the actual -# binary data file. -# -# See usage note below. -# -# TODO: The Property[Value]Alias.txt files state that they can support -# more than 2 names per property|value. Currently (Unicode 3.2) there -# are always 1 or 2 names. If more names were supported, presumably -# the format would be something like: -# nv ; Numeric_Value -# nv ; Value_Numerique -# CURRENTLY, this script assumes that there are 1 or two names. Any -# duplicates it sees are flagged as an error. If multiple aliases -# appear in a future version of Unicode, modify this script to support -# that. -# -# NOTE: As of ICU 2.6, this script has been modified to know about the -# pseudo-property gcm/General_Category_Mask, which corresponds to the -# uchar.h property UCHAR_GENERAL_CATEGORY_MASK. This property -# corresponds to General_Category but is a bitmask value. It does not -# exist in the UCD. Therefore, I special case it in several places -# (search for General_Category_Mask and gcm). -# -# NOTE: As of ICU 2.6, this script reads an auxiliary data file, -# SyntheticPropertyAliases.txt, containing property aliases not -# present in the UCD but present in ICU. This file resides in the -# same directory as this script. Its contents are merged into those -# of PropertyAliases.txt as if the two files were appended. -# -# NOTE: The following names are handled specially. See script below -# for details. -# -# T/True -# F/False -# No_Block -# -# Author: Alan Liu -# Created: October 14 2002 -# Since: ICU 2.4 - -use FileHandle; -use strict; -use Dumpvalue; - -my $DEBUG = 1; -my $DUMPER = new Dumpvalue; - -my $count = @ARGV; -my $ICU_DIR = shift() || ''; -my $OUT_FILE = shift() || 'data.h'; -my $HEADER_DIR = "$ICU_DIR/source/common/unicode"; -my $UNIDATA_DIR = "$ICU_DIR/source/data/unidata"; - -# Get the current year from the system -my $YEAR = 1900+@{[localtime]}[5]; # Get the current year - -# Used to make "n/a" property [value] aliases (Unicode or Synthetic) unique -my $propNA = 0; -my $valueNA = 0; - -#---------------------------------------------------------------------- -# Top level property keys for binary, enumerated, string, and double props -my @TOP = qw( _bp _ep _sp _dp _mp ); - -# This hash governs how top level properties are grouped into output arrays. -#my %TOP_PROPS = ( "VALUED" => [ '_bp', '_ep' ], -# "NO_VALUE" => [ '_sp', '_dp' ] );m -#my %TOP_PROPS = ( "BINARY" => [ '_bp' ], -# "ENUMERATED" => [ '_ep' ], -# "STRING" => [ '_sp' ], -# "DOUBLE" => [ '_dp' ] ); -my %TOP_PROPS = ( "" => [ '_bp', '_ep', '_sp', '_dp', '_mp' ] ); - -my %PROP_TYPE = (Binary => "_bp", - String => "_sp", - Double => "_dp", - Enumerated => "_ep", - Bitmask => "_mp"); -#---------------------------------------------------------------------- - -# Properties that are unsupported in ICU -my %UNSUPPORTED = (Composition_Exclusion => 1, - Decomposition_Mapping => 1, - Expands_On_NFC => 1, - Expands_On_NFD => 1, - Expands_On_NFKC => 1, - Expands_On_NFKD => 1, - FC_NFKC_Closure => 1, - ID_Start_Exceptions => 1, - Special_Case_Condition => 1, - ); - -# Short names of properties that weren't seen in uchar.h. If the -# properties weren't seen, don't complain about the property values -# missing. -my %MISSING_FROM_UCHAR; - -# Additional property aliases beyond short and long names, -# like space in addition to WSpace and White_Space in Unicode 4.1. -# Hashtable, maps long name to alias. -# For example, maps White_Space->space. -# -# If multiple additional aliases are defined, -# then they are separated in the value string with '|'. -# For example, White_Space->space|outer_space -my %additional_property_aliases; - -#---------------------------------------------------------------------- - -# Emitted class names -my ($STRING_CLASS, $ALIAS_CLASS, $PROPERTY_CLASS) = qw(AliasName Alias Property); - -if ($count < 1 || $count > 2 || - !-d $HEADER_DIR || - !-d $UNIDATA_DIR) { - my $me = $0; - $me =~ s|.+[/\\]||; - my $lm = ' ' x length($me); - print <<"END"; - -$me: Reads ICU4C headers and Unicode data files and creates -$lm a C header file that is included by genpname. The header -$lm file matches constants defined in the ICU4C headers with -$lm property|value aliases in the Unicode data files. - -Usage: $me <icu_dir> [<out_file>] - -<icu_dir> ICU4C root directory, containing - source/common/unicode/uchar.h - source/common/unicode/uscript.h - source/data/unidata/Blocks.txt - source/data/unidata/PropertyAliases.txt - source/data/unidata/PropertyValueAliases.txt -<out_file> File name of header to be written; - default is 'data.h'. - -The Unicode versions of all input files must match. -END - exit(1); -} - -my ($h, $version) = readAndMerge($HEADER_DIR, $UNIDATA_DIR); - -if ($DEBUG) { - print "Merged hash:\n"; - for my $key (sort keys %$h) { - my $hh = $h->{$key}; - for my $subkey (sort keys %$hh) { - print "$key:$subkey:", $hh->{$subkey}, "\n"; - } - } -} - -my $out = new FileHandle($OUT_FILE, 'w'); -die "Error: Can't write to $OUT_FILE: $!" unless (defined $out); -my $save = select($out); -formatData($h, $version); -select($save); -$out->close(); - -exit(0); - -#---------------------------------------------------------------------- -# From PropList.html: "The properties of the form Other_XXX -# are used to generate properties in DerivedCoreProperties.txt. -# They are not intended for general use, such as in APIs that -# return property values. -# Non_Break is not a valid property as of 3.2. -sub isIgnoredProperty { - local $_ = shift; - /^Other_/i || /^Non_Break$/i; -} - -# 'qc' is a pseudo-property matching any quick-check property -# see PropertyValueAliases.txt file comments. 'binprop' is -# a synthetic binary value alias "True"/"False", not present -# in PropertyValueAliases.txt until Unicode 5.0. -# Starting with Unicode 5.1, PropertyValueAliases.txt does have -# explicit values for binary properties. -sub isPseudoProperty { - $_[0] eq 'qc' || - $_[0] eq 'binprop'; -} - -#---------------------------------------------------------------------- -# Emit the combined data from headers and the Unicode database as a -# C source code header file. -# -# @param ref to hash with the data -# @param Unicode version, as a string -sub formatData { - my $h = shift; - my $version = shift; - - my $date = scalar localtime(); - print <<"END"; -/** - * Copyright (C) 2002-$YEAR, International Business Machines Corporation and - * others. All Rights Reserved. - * - * MACHINE GENERATED FILE. !!! Do not edit manually !!! - * - * Generated from - * uchar.h - * uscript.h - * Blocks.txt - * PropertyAliases.txt - * PropertyValueAliases.txt - * - * Date: $date - * Unicode version: $version - * Script: $0 - */ - -END - - #------------------------------------------------------------ - # Emit Unicode version - print "/* Unicode version $version */\n"; - my @v = split(/\./, $version); - push @v, '0' while (@v < 4); - for (my $i=0; $i<@v; ++$i) { - print "const uint8_t VERSION_$i = $v[$i];\n"; - } - print "\n"; - - #------------------------------------------------------------ - # Emit String table - # [A table of all identifiers, that is, all long or short property - # or value names. The list need NOT be sorted; it will be sorted - # by the C program. Strings are referenced by their index into - # this table. After sorting, a REMAP[] array is used to map the - # old position indices to the new positions.] - my %strings; - for my $prop (sort keys %$h) { - my $hh = $h->{$prop}; - for my $enum (sort keys %$hh) { - my @a = split(/\|/, $hh->{$enum}); - for (@a) { - $strings{$_} = 1 if (length($_)); - } - } - } - my @strings = sort keys %strings; - unshift @strings, ""; - - print "const int32_t STRING_COUNT = ", scalar @strings, ";\n\n"; - - # while printing, create a mapping hash from string table entry to index - my %stringToID; - print "/* to be sorted */\n"; - print "const $STRING_CLASS STRING_TABLE[] = {\n"; - for (my $i=0; $i<@strings; ++$i) { - print " $STRING_CLASS(\"$strings[$i]\", $i),\n"; - $stringToID{$strings[$i]} = $i; - } - print "};\n\n"; - - # placeholder for the remapping index. this is used to map - # indices that we compute here to indices of the sorted - # STRING_TABLE. STRING_TABLE will be sorted by the C++ program - # using the uprv_comparePropertyNames() function. this will - # reshuffle the order. we then use the indices (passed to the - # String constructor) to create a REMAP[] array. - print "/* to be filled in */\n"; - print "int32_t REMAP[", scalar @strings, "];\n\n"; - - #------------------------------------------------------------ - # Emit the name group table - # [A table of name groups. A name group is one or more names - # for a property or property value. The Unicode data files specify - # that there may be more than 2, although as of Unicode 3.2 there - # are at most 2. The name group table looks like this: - # - # 114, -115, 116, -117, 0, -118, 65, -64, ... - # [0] [2] [4] [6] - # - # The entry at [0] consists of 2 strings, 114 and 115. - # The entry at [2] consists of 116 and 117. The entry at - # [4] is one string, 118. There is always at least one - # string; typically there are two. If there are two, the first - # is the SHORT name and the second is the LONG. If there is - # one, then the missing entry (always the short name, in 3.2) - # is zero, which is by definition the index of "". The - # 'preferred' name will generally be the LONG name, if there are - # more than 2 entries. The last entry is negative. - - # Build name group list and replace string refs with nameGroup indices - my @nameGroups; - - # Check for duplicate name groups, and reuse them if possible - my %groupToInt; # Map group strings to ints - for my $prop (sort keys %$h) { - my $hh = $h->{$prop}; - for my $enum (sort keys %$hh) { - my $groupString = $hh->{$enum}; - my $i; - if (exists $groupToInt{$groupString}) { - $i = $groupToInt{$groupString}; - } else { - my @names = split(/\|/, $groupString); - die "Error: Wrong number of names in " . $groupString if (@names < 1); - $i = @nameGroups; # index of group we are making - $groupToInt{$groupString} = $i; # Cache for reuse - push @nameGroups, map { $stringToID{$_} } @names; - $nameGroups[$#nameGroups] = -$nameGroups[$#nameGroups]; # mark end - } - # now, replace string list with ref to name group - $hh->{$enum} = $i; - } - } - - print "const int32_t NAME_GROUP_COUNT = ", - scalar @nameGroups, ";\n\n"; - - print "int32_t NAME_GROUP[] = {\n"; - # emit one group per line, with annotations - my $max_names = 0; - for (my $i=0; $i<@nameGroups; ) { - my @a; - my $line; - my $start = $i; - for (;;) { - my $j = $nameGroups[$i++]; - $line .= "$j, "; - push @a, abs($j); - last if ($j < 0); - } - print " ", - $line, - ' 'x(20-length($line)), - "/* ", sprintf("%3d", $start), - ": \"", join("\", \"", map { $strings[$_] } @a), "\" */\n"; - $max_names = @a if(@a > $max_names); - - } - print "};\n\n"; - - # This is fixed for 3.2 at "2" but should be calculated dynamically - # when more than 2 names appear in Property[Value]Aliases.txt. - print "#define MAX_NAMES_PER_GROUP $max_names\n\n"; - - #------------------------------------------------------------ - # Emit enumerated property values - for my $prop (sort keys %$h) { - next if ($prop =~ /^_/); - my $vh = $h->{$prop}; - my $count = scalar keys %$vh; - - print "const int32_t VALUES_${prop}_COUNT = ", - $count, ";\n\n"; - - print "const $ALIAS_CLASS VALUES_${prop}\[] = {\n"; - for my $enum (sort keys %$vh) { - #my @names = split(/\|/, $vh->{$enum}); - #die "Error: Wrong number of names for $prop:$enum in [" . join(",", @names) . "]" - # if (@names != 2); - print " $ALIAS_CLASS((int32_t) $enum, ", $vh->{$enum}, "),\n"; - #$stringToID{$names[0]}, ", ", - #$stringToID{$names[1]}, "),\n"; - # "\"", $names[0], "\", ", - # "\"", $names[1], "\"),\n"; - } - print "};\n\n"; - } - - #------------------------------------------------------------ - # Emit top-level properties (binary, enumerated, etc.) - for my $topName (sort keys %TOP_PROPS) { - my $a = $TOP_PROPS{$topName}; - my $count = 0; - for my $type (@$a) { # "_bp", "_ep", etc. - $count += scalar keys %{$h->{$type}}; - } - - print "const int32_t ${topName}PROPERTY_COUNT = $count;\n\n"; - - print "const $PROPERTY_CLASS ${topName}PROPERTY[] = {\n"; - - for my $type (@$a) { # "_bp", "_ep", etc. - my $p = $h->{$type}; - - for my $enum (sort keys %$p) { - my $name = $strings[$nameGroups[$p->{$enum}]]; - - my $valueRef = "0, NULL"; - if ($type eq '_bp') { - $valueRef = "VALUES_binprop_COUNT, VALUES_binprop"; - } - elsif (exists $h->{$name}) { - $valueRef = "VALUES_${name}_COUNT, VALUES_$name"; - } - - print " $PROPERTY_CLASS((int32_t) $enum, ", - $p->{$enum}, ", $valueRef),\n"; - } - } - print "};\n\n"; - } - - print "/*eof*/\n"; -} - -#---------------------------------------------------------------------- -# Read in the files uchar.h, uscript.h, Blocks.txt, -# PropertyAliases.txt, and PropertyValueAliases.txt, -# and combine them into one hash. -# -# @param directory containing headers -# @param directory containin Unicode data files -# -# @return hash ref, Unicode version -sub readAndMerge { - - my ($headerDir, $unidataDir) = @_; - - my $h = read_uchar("$headerDir/uchar.h"); - my $s = read_uscript("$headerDir/uscript.h"); - my $b = read_Blocks("$unidataDir/Blocks.txt"); - my $pa = {}; - read_PropertyAliases($pa, "$unidataDir/PropertyAliases.txt"); - read_PropertyAliases($pa, "SyntheticPropertyAliases.txt"); - my $va = {}; - read_PropertyValueAliases($va, "$unidataDir/PropertyValueAliases.txt"); - read_PropertyValueAliases($va, "SyntheticPropertyValueAliases.txt"); - - # Extract property family hash - my $fam = $pa->{'_family'}; - delete $pa->{'_family'}; - - # Note: uscript.h has no version string, so don't check it - my $version = check_versions([ 'uchar.h', $h ], - [ 'Blocks.txt', $b ], - [ 'PropertyAliases.txt', $pa ], - [ 'PropertyValueAliases.txt', $va ]); - - # Do this BEFORE merging; merging modifies the hashes - check_PropertyValueAliases($pa, $va); - - # Dump out the $va hash for debugging - if ($DEBUG) { - print "Property values hash:\n"; - for my $key (sort keys %$va) { - my $hh = $va->{$key}; - for my $subkey (sort keys %$hh) { - print "$key:$subkey:", $hh->{$subkey}, "\n"; - } - } - } - - # Dump out the $s hash for debugging - if ($DEBUG) { - print "Script hash:\n"; - for my $key (sort keys %$s) { - print "$key:", $s->{$key}, "\n"; - } - } - - # Link in the script data - $h->{'sc'} = $s; - - merge_Blocks($h, $b); - - merge_PropertyAliases($h, $pa, $fam); - - merge_PropertyValueAliases($h, $va); - - ($h, $version); -} - -#---------------------------------------------------------------------- -# Ensure that the version strings in the given hashes (under the key -# '_version') are compatible. Currently this means they must be -# identical, with the exception that "X.Y" will match "X.Y.0". -# All hashes must define the key '_version'. -# -# @param a list of pairs of (file name, hash reference) -# -# @return the version of all the hashes. Upon return, the '_version' -# will be removed from all hashes. -sub check_versions { - my $version = ''; - my $msg = ''; - foreach my $a (@_) { - my $name = $a->[0]; - my $h = $a->[1]; - die "Error: No version found" unless (exists $h->{'_version'}); - my $v = $h->{'_version'}; - delete $h->{'_version'}; - - # append ".0" if necessary, to standardize to X.Y.Z - $v .= '.0' unless ($v =~ /\.\d+\./); - $v .= '.0' unless ($v =~ /\.\d+\./); - $msg .= "$name = $v\n"; - if ($version) { - die "Error: Mismatched Unicode versions\n$msg" - unless ($version eq $v); - } else { - $version = $v; - } - } - $version; -} - -#---------------------------------------------------------------------- -# Make sure the property names in PropertyValueAliases.txt match those -# in PropertyAliases.txt. -# -# @param a hash ref from read_PropertyAliases. -# @param a hash ref from read_PropertyValueAliases. -sub check_PropertyValueAliases { - my ($pa, $va) = @_; - - # make a reverse hash of short->long - my %rev; - for (keys %$pa) { $rev{$pa->{$_}} = $_; } - - for my $prop (keys %$va) { - if (!exists $rev{$prop} && !isPseudoProperty($prop)) { - print "Warning: Property $prop from PropertyValueAliases not listed in PropertyAliases\n"; - } - } -} - -#---------------------------------------------------------------------- -# Merge blocks data into uchar.h enum data. In the 'blk' subhash all -# code point values, as returned from read_uchar, are replaced by -# block names, as read from Blocks.txt and returned by read_Blocks. -# The match must be 1-to-1. If there is any failure of 1-to-1 -# mapping, an error is signaled. Upon return, the read_Blocks hash -# is emptied of all contents, except for those that failed to match. -# -# The mapping in the 'blk' subhash, after this function returns, is -# from uchar.h enum name, e.g. "UBLOCK_BASIC_LATIN", to Blocks.h -# pseudo-name, e.g. "Basic Latin". -# -# @param a hash ref from read_uchar. -# @param a hash ref from read_Blocks. -sub merge_Blocks { - my ($h, $b) = @_; - - die "Error: No blocks data in uchar.h" - unless (exists $h->{'blk'}); - my $blk = $h->{'blk'}; - for my $enum (keys %$blk) { - my $cp = $blk->{$enum}; - if ($cp && !exists $b->{$cp}) { - die "Error: No block found at $cp in Blocks.txt"; - } - # Convert code point to pseudo-name: - $blk->{$enum} = $b->{$cp}; - delete $b->{$cp}; - } - my $err = ''; - for my $cp (keys %$b) { - $err .= "Error: Block " . $b->{$cp} . " not listed in uchar.h\n"; - } - die $err if ($err); -} - -#---------------------------------------------------------------------- -# Merge property alias names into the uchar.h hash. The subhashes -# under the keys _* (b(inary, e(numerated, s(tring, d(ouble) are -# examined and the values of those subhashes are assumed to be long -# names in PropertyAliases.txt. They are validated and replaced by -# "<short>|<long>". Upon return, the read_PropertyAliases hash is -# emptied of all contents, except for those that failed to match. -# Unmatched names in PropertyAliases are listed as a warning but do -# NOT cause the script to die. -# -# @param a hash ref from read_uchar. -# @param a hash ref from read_PropertyAliases. -# @param a hash mapping long names to property family (e.g., 'binary') -sub merge_PropertyAliases { - my ($h, $pa, $fam) = @_; - - for my $k (@TOP) { - die "Error: No properties data for $k in uchar.h" - unless (exists $h->{$k}); - } - - for my $subh (map { $h->{$_} } @TOP) { - for my $enum (keys %$subh) { - my $long_name = $subh->{$enum}; - if (!exists $pa->{$long_name}) { - die "Error: Property $long_name not found (or used more than once)"; - } - - my $value; - if($pa->{$long_name} =~ m|^n/a\d*$|) { - # replace an "n/a" short name with an empty name (nothing before "|"); - # don't remove it (don't remove the "|"): there must always be a long name, - # and if the short name is removed, then the long name becomes the - # short name and there is no long name left (unless there is another alias) - $value = "|" . $long_name; - } else { - $value = $pa->{$long_name} . "|" . $long_name; - } - if (exists $additional_property_aliases{$long_name}) { - $value .= "|" . $additional_property_aliases{$long_name}; - } - $subh->{$enum} = $value; - delete $pa->{$long_name}; - } - } - - my @err; - for my $name (keys %$pa) { - $MISSING_FROM_UCHAR{$pa->{$name}} = 1; - if (exists $UNSUPPORTED{$name}) { - push @err, "Info: No enum for " . $fam->{$name} . " property $name in uchar.h"; - } elsif (!isIgnoredProperty($name)) { - push @err, "Warning: No enum for " . $fam->{$name} . " property $name in uchar.h"; - } - } - print join("\n", sort @err), "\n" if (@err); -} - -#---------------------------------------------------------------------- -# Return 1 if two names match ignoring whitespace, '-', and '_'. -# Used to match names in Blocks.txt with those in PropertyValueAliases.txt -# as of Unicode 4.0. -sub matchesLoosely { - my ($a, $b) = @_; - $a =~ s/[\s\-_]//g; - $b =~ s/[\s\-_]//g; - $a =~ /^$b$/i; -} - -#---------------------------------------------------------------------- -# Merge PropertyValueAliases.txt data into the uchar.h hash. All -# properties other than blk, _bp, and _ep are analyzed and mapped to -# the names listed in PropertyValueAliases. They are then replaced -# with a string of the form "<short>|<long>". The short or long name -# may be missing. -# -# @param a hash ref from read_uchar. -# @param a hash ref from read_PropertyValueAliases. -sub merge_PropertyValueAliases { - my ($h, $va) = @_; - - my %gcCount; - for my $prop (keys %$h) { - # _bp, _ep handled in merge_PropertyAliases - next if ($prop =~ /^_/); - - # Special case: gcm - my $prop2 = ($prop eq 'gcm') ? 'gc' : $prop; - - # find corresponding PropertyValueAliases data - die "Error: Can't find $prop in PropertyValueAliases.txt" - unless (exists $va->{$prop2}); - my $pva = $va->{$prop2}; - - # match up data - my $hh = $h->{$prop}; - for my $enum (keys %$hh) { - - my $name = $hh->{$enum}; - - # look up both long and short & ignore case - my $n; - if (exists $pva->{$name}) { - $n = $name; - } else { - # iterate (slow) - for my $a (keys %$pva) { - # case-insensitive match - # & case-insensitive reverse match - if ($a =~ /^$name$/i || - $pva->{$a} =~ /^$name$/i) { - $n = $a; - last; - } - } - } - - # For blocks, do a loose match from Blocks.txt pseudo-name - # to PropertyValueAliases long name. - if (!$n && $prop eq 'blk') { - for my $a (keys %$pva) { - # The block is only going to match the long name, - # but we check both for completeness. As of Unicode - # 4.0, blocks do not have short names. - if (matchesLoosely($name, $pva->{$a}) || - matchesLoosely($name, $a)) { - $n = $a; - last; - } - } - } - - die "Error: Property value $prop:$name not found" unless ($n); - - my $l = $n; - my $r = $pva->{$n}; - # convert |n/a\d*| to blank - $l = '' if ($l =~ m|^n/a\d*$|); - $r = '' if ($r =~ m|^n/a\d*$|); - - $hh->{$enum} = "$l|$r"; - # Don't delete the 'gc' properties because we need to share - # them between 'gc' and 'gcm'. Count each use instead. - if ($prop2 eq 'gc') { - ++$gcCount{$n}; - } else { - delete $pva->{$n}; - } - } - } - - # Merge the combining class values in manually - # Add the same values to the synthetic lccc and tccc properties - die "Error: No ccc data" - unless exists $va->{'ccc'}; - for my $ccc (keys %{$va->{'ccc'}}) { - die "Error: Can't overwrite ccc $ccc" - if (exists $h->{'ccc'}->{$ccc}); - $h->{'lccc'}->{$ccc} = - $h->{'tccc'}->{$ccc} = - $h->{'ccc'}->{$ccc} = $va->{'ccc'}->{$ccc}; - } - delete $va->{'ccc'}; - - # Merge synthetic binary property values in manually. - # These are the "True" and "False" value aliases. - die "Error: No True/False value aliases" - unless exists $va->{'binprop'}; - for my $bp (keys %{$va->{'binprop'}}) { - $h->{'binprop'}->{$bp} = $va->{'binprop'}->{$bp}; - } - delete $va->{'binprop'}; - - my $err = ''; - for my $prop (sort keys %$va) { - my $hh = $va->{$prop}; - for my $subkey (sort keys %$hh) { - # 'gc' props are shared with 'gcm'; make sure they were used - # once or twice. - if ($prop eq 'gc') { - my $n = $gcCount{$subkey}; - next if ($n >= 1 && $n <= 2); - } - $err .= "Warning: Enum for value $prop:$subkey not found in uchar.h\n" - unless exists $MISSING_FROM_UCHAR{$prop}; - } - } - print $err if ($err); -} - -#---------------------------------------------------------------------- -# Read the PropertyAliases.txt file. Return a hash that maps the long -# name to the short name. The special key '_version' will map to the -# Unicode version of the file. The special key '_family' holds a -# subhash that maps long names to a family string, for descriptive -# purposes. -# -# @param a filename for PropertyAliases.txt -# @param reference to hash to receive data. Keys are long names. -# Values are short names. -sub read_PropertyAliases { - - my $hash = shift; # result - - my $filename = shift; - - my $fam = {}; # map long names to family string - $fam = $hash->{'_family'} if (exists $hash->{'_family'}); - - my $family; # binary, enumerated, etc. - - my $in = new FileHandle($filename, 'r'); - die "Error: Cannot open $filename" if (!defined $in); - - while (<$in>) { - - # Read version (embedded in a comment) - if (/PropertyAliases-(\d+\.\d+\.\d+)/i) { - die "Error: Multiple versions in $filename" - if (exists $hash->{'_version'}); - $hash->{'_version'} = $1; - } - - # Read family heading - if (/^\s*\#\s*(.+?)\s*Properties\s*$/) { - $family = $1; - } - - # Ignore comments and blank lines - s/\#.*//; - next unless (/\S/); - - if (/^\s*(.+?)\s*;/) { - my $short = $1; - my @fields = /;\s*([^\s;]+)/g; - if (@fields < 1) { - my $number = @fields; - die "Error: Wrong number of fields ($number) in $filename at $_"; - } - - # Make "n/a" strings unique - if ($short eq 'n/a') { - $short .= sprintf("%03d", $propNA++); - } - my $long = $fields[0]; - if ($long eq 'n/a') { - $long .= sprintf("%03d", $propNA++); - } - - # Add long name->short name to the hash=pa hash table - if (exists $hash->{$long}) { - die "Error: Duplicate property $long in $filename" - } - $hash->{$long} = $short; - $fam->{$long} = $family; - - # Add the list of further aliases to the additional_property_aliases hash table, - # using the long property name as the key. - # For example: - # White_Space->space|outer_space - if (@fields > 1) { - my $value = pop @fields; - while (@fields > 1) { - $value .= "|" . pop @fields; - } - $additional_property_aliases{$long} = $value; - } - } else { - die "Error: Can't parse $_ in $filename"; - } - } - - $in->close(); - - $hash->{'_family'} = $fam; -} - -#---------------------------------------------------------------------- -# Read the PropertyValueAliases.txt file. Return a two level hash -# that maps property_short_name:value_short_name:value_long_name. In -# the case of the 'ccc' property, the short name is the numeric class -# and the long name is "<short>|<long>". The special key '_version' -# will map to the Unicode version of the file. -# -# @param a filename for PropertyValueAliases.txt -# -# @return a hash reference. -sub read_PropertyValueAliases { - - my $hash = shift; # result - - my $filename = shift; - - my $in = new FileHandle($filename, 'r'); - die "Error: Cannot open $filename" if (!defined $in); - - while (<$in>) { - - # Read version (embedded in a comment) - if (/PropertyValueAliases-(\d+\.\d+\.\d+)/i) { - die "Error: Multiple versions in $filename" - if (exists $hash->{'_version'}); - $hash->{'_version'} = $1; - } - - # Ignore comments and blank lines - s/\#.*//; - next unless (/\S/); - - if (/^\s*(.+?)\s*;/i) { - my $prop = $1; - my @fields = /;\s*([^\s;]+)/g; - die "Error: Wrong number of fields in $filename" - if (@fields < 2 || @fields > 5); - # Make "n/a" strings unique - $fields[0] .= sprintf("%03d", $valueNA++) if ($fields[0] eq 'n/a'); - # Squash extra fields together - while (@fields > 2) { - my $f = pop @fields; - $fields[$#fields] .= '|' . $f; - } - addDatum($hash, $prop, @fields); - } - - else { - die "Error: Can't parse $_ in $filename"; - } - } - - $in->close(); - - # Script Copt=Qaac (Coptic) is a special case. - # Before the Copt code was defined, the private-use code Qaac was used. - # Starting with Unicode 4.1, PropertyValueAliases.txt contains - # Copt as the short name as well as Qaac as an alias. - # For use with older Unicode data files, we add here a Qaac->Coptic entry. - # This should not do anything for 4.1-and-later Unicode data files. - # See also UAX #24: Script Names http://www.unicode.org/unicode/reports/tr24/ - $hash->{'sc'}->{'Qaac'} = 'Coptic' - unless (exists $hash->{'sc'}->{'Qaac'} || exists $hash->{'sc'}->{'Copt'}); - - # Add N|No|T|True and Y|Yes|F|False -- these are values we recognize for - # binary properties (until Unicode 5.0 NOT from PropertyValueAliases.txt). - # These are of the same form as the 'ccc' value aliases. - # Starting with Unicode 5.1, PropertyValueAliases.txt does have values - # for binary properties. - if (!exists $hash->{'binprop'}->{'0'}) { - if (exists $hash->{'Alpha'}->{'N'}) { - # Unicode 5.1 and later: Make the numeric value the key. - $hash->{'binprop'}->{'0'} = 'N|' . $hash->{'Alpha'}->{'N'}; - $hash->{'binprop'}->{'1'} = 'Y|' . $hash->{'Alpha'}->{'Y'}; - } elsif (exists $hash->{'Alpha'}) { - die "Error: Unrecognized short value name for binary property 'Alpha'\n"; - } else { - # Unicode 5.0 and earlier: Add manually. - $hash->{'binprop'}->{'0'} = 'N|No|F|False'; - $hash->{'binprop'}->{'1'} = 'Y|Yes|T|True'; - } - } -} - -#---------------------------------------------------------------------- -# Read the Blocks.txt file. Return a hash that maps the code point -# range start to the block name. The special key '_version' will map -# to the Unicode version of the file. -# -# As of Unicode 4.0, the names in the Blocks.txt are no longer the -# proper names. The proper names are now listed in PropertyValueAliases. -# They are similar but not identical. Furthermore, 4.0 introduces -# a new block name, No_Block, which is listed only in PropertyValueAliases -# and not in Blocks.txt. As a result, we handle blocks as follows: -# -# 1. Read Blocks.txt to map code point range start to quasi-block name. -# 2. Add to Blocks.txt a synthetic No Block code point & name: -# X -> No Block -# 3. Map quasi-names from Blocks.txt (including No Block) to actual -# names from PropertyValueAliases. This occurs in -# merge_PropertyValueAliases. -# -# @param a filename for Blocks.txt -# -# @return a ref to a hash. Keys are code points, as text, e.g., -# "1720". Values are pseudo-block names, e.g., "Hanunoo". -sub read_Blocks { - - my $filename = shift; - - my $hash = {}; # result - - my $in = new FileHandle($filename, 'r'); - die "Error: Cannot open $filename" if (!defined $in); - - while (<$in>) { - - # Read version (embedded in a comment) - if (/Blocks-(\d+\.\d+\.\d+)/i) { - die "Error: Multiple versions in $filename" - if (exists $hash->{'_version'}); - $hash->{'_version'} = $1; - } - - # Ignore comments and blank lines - s/\#.*//; - next unless (/\S/); - - if (/^([0-9a-f]+)\.\.[0-9a-f]+\s*;\s*(.+?)\s*$/i) { - die "Error: Duplicate range $1 in $filename" - if (exists $hash->{$1}); - $hash->{$1} = $2; - } - - else { - die "Error: Can't parse $_ in $filename"; - } - } - - $in->close(); - - # Add pseudo-name for No Block - $hash->{'none'} = 'No Block'; - - $hash; -} - -#---------------------------------------------------------------------- -# Read the uscript.h file and compile a mapping of Unicode symbols to -# icu4c enum values. -# -# @param a filename for uscript.h -# -# @return a ref to a hash. The keys of the hash are enum symbols from -# uscript.h, and the values are script names. -sub read_uscript { - - my $filename = shift; - - my $mode = ''; # state machine mode and submode - my $submode = ''; - - my $last = ''; # for line folding - - my $hash = {}; # result - my $key; # first-level key - - my $in = new FileHandle($filename, 'r'); - die "Error: Cannot open $filename" if (!defined $in); - - while (<$in>) { - # Fold continued lines together - if (/^(.*)\\$/) { - $last = $1; - next; - } elsif ($last) { - $_ = $last . $_; - $last = ''; - } - - # Exit all modes here - if ($mode && $mode ne 'DEPRECATED') { - if (/^\s*\}/) { - $mode = ''; - next; - } - } - - # Handle individual modes - - if ($mode eq 'UScriptCode') { - if (m|^\s*(USCRIPT_\w+).+?/\*\s*(\w+)|) { - my ($enum, $code) = ($1, $2); - die "Error: Duplicate script $enum" - if (exists $hash->{$enum}); - $hash->{$enum} = $code; - } - } - - elsif ($mode eq 'DEPRECATED') { - if (/\s*\#ifdef/) { - die "Error: Nested #ifdef"; - } - elsif (/\s*\#endif/) { - $mode = ''; - } - } - - elsif (!$mode) { - if (/^\s*typedef\s+enum\s+(\w+)\s*\{/ || - /^\s*typedef\s+enum\s+(\w+)\s*$/) { - $mode = $1; - #print "Parsing $mode\n"; - } - - elsif (/^\s*\#ifdef\s+ICU_UCHAR_USE_DEPRECATES\b/) { - $mode = 'DEPRECATED'; - } - } - } - - $in->close(); - - $hash; -} - -#---------------------------------------------------------------------- -# Read the uchar.h file and compile a mapping of Unicode symbols to -# icu4c enum values. -# -# @param a filename for uchar.h -# -# @return a ref to a hash. The keys of the hash are '_bp' for binary -# properties, '_ep' for enumerated properties, '_dp'/'_sp'/'_mp' for -# double/string/mask properties, and 'gc', 'gcm', 'bc', 'blk', -# 'ea', 'dt', 'jt', 'jg', 'lb', or 'nt' for corresponding property -# value aliases. The values of the hash are subhashes. The subhashes -# have a key of the uchar.h enum symbol, and a value of the alias -# string (as listed in PropertyValueAliases.txt). NOTE: The alias -# string is whatever alias uchar.h lists. This may be either short or -# long, depending on the specific enum. NOTE: For blocks ('blk'), the -# value is a hex code point for the start of the associated block. -# NOTE: The special key _version will map to the Unicode version of -# the file. -sub read_uchar { - - my $filename = shift; - - my $mode = ''; # state machine mode and submode - my $submode = ''; - - my $last = ''; # for line folding - - my $hash = {}; # result - my $key; # first-level key - - my $in = new FileHandle($filename, 'r'); - die "Error: Cannot open $filename" if (!defined $in); - - while (<$in>) { - # Fold continued lines together - if (/^(.*)\\$/) { - $last .= $1; - next; - } elsif ($last) { - $_ = $last . $_; - $last = ''; - } - - # Exit all modes here - if ($mode && $mode ne 'DEPRECATED') { - if (/^\s*\}/) { - $mode = ''; - next; - } - } - - # Handle individual modes - - if ($mode eq 'UProperty') { - if (/^\s*(UCHAR_\w+)\s*[,=]/ || /^\s+(UCHAR_\w+)\s*$/) { - if ($submode) { - addDatum($hash, $key, $1, $submode); - $submode = ''; - } else { - #print "Warning: Ignoring $1\n"; - } - } - - elsif (m|^\s*/\*\*\s*(\w+)\s+property\s+(\w+)|i) { - die "Error: Unmatched tag $submode" if ($submode); - die "Error: Unrecognized UProperty comment: $_" - unless (exists $PROP_TYPE{$1}); - $key = $PROP_TYPE{$1}; - $submode = $2; - } - } - - elsif ($mode eq 'UCharCategory') { - if (/^\s*(U_\w+)\s*=/) { - if ($submode) { - addDatum($hash, 'gc', $1, $submode); - $submode = ''; - } else { - #print "Warning: Ignoring $1\n"; - } - } - - elsif (m|^\s*/\*\*\s*([A-Z][a-z])\s|) { - die "Error: Unmatched tag $submode" if ($submode); - $submode = $1; - } - } - - elsif ($mode eq 'UCharDirection') { - if (/^\s*(U_\w+)\s*[,=]/ || /^\s+(U_\w+)\s*$/) { - if ($submode) { - addDatum($hash, $key, $1, $submode); - $submode = ''; - } else { - #print "Warning: Ignoring $1\n"; - } - } - - elsif (m|/\*\*\s*([A-Z]+)\s|) { - die "Error: Unmatched tag $submode" if ($submode); - $key = 'bc'; - $submode = $1; - } - } - - elsif ($mode eq 'UBlockCode') { - if (m|^\s*(UBLOCK_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'blk', $1, $2); - } - } - - elsif ($mode eq 'UEastAsianWidth') { - if (m|^\s*(U_EA_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'ea', $1, $2); - } - } - - elsif ($mode eq 'UDecompositionType') { - if (m|^\s*(U_DT_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'dt', $1, $2); - } - } - - elsif ($mode eq 'UJoiningType') { - if (m|^\s*(U_JT_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'jt', $1, $2); - } - } - - elsif ($mode eq 'UJoiningGroup') { - if (/^\s*(U_JG_(\w+))/) { - addDatum($hash, 'jg', $1, $2) unless ($2 eq 'COUNT'); - } - } - - elsif ($mode eq 'UGraphemeClusterBreak') { - if (m|^\s*(U_GCB_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'GCB', $1, $2); - } - } - - elsif ($mode eq 'UWordBreakValues') { - if (m|^\s*(U_WB_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'WB', $1, $2); - } - } - - elsif ($mode eq 'USentenceBreak') { - if (m|^\s*(U_SB_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'SB', $1, $2); - } - } - - elsif ($mode eq 'ULineBreak') { - if (m|^\s*(U_LB_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'lb', $1, $2); - } - } - - elsif ($mode eq 'UNumericType') { - if (m|^\s*(U_NT_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'nt', $1, $2); - } - } - - elsif ($mode eq 'UHangulSyllableType') { - if (m|^\s*(U_HST_\w+).+?/\*\[(.+?)\]\*/|) { - addDatum($hash, 'hst', $1, $2); - } - } - - elsif ($mode eq 'DEPRECATED') { - if (/\s*\#ifdef/) { - die "Error: Nested #ifdef"; - } - elsif (/\s*\#endif/) { - $mode = ''; - } - } - - elsif (!$mode) { - if (/^\s*\#define\s+(\w+)\s+(.+)/) { - # #define $left $right - my ($left, $right) = ($1, $2); - - if ($left eq 'U_UNICODE_VERSION') { - my $version = $right; - $version = $1 if ($version =~ /^\"(.*)\"/); - # print "Unicode version: ", $version, "\n"; - die "Error: Multiple versions in $filename" - if (defined $hash->{'_version'}); - $hash->{'_version'} = $version; - } - - elsif ($left =~ /U_GC_(\w+?)_MASK/) { - addDatum($hash, 'gcm', $left, $1); - } - } - - elsif (/^\s*typedef\s+enum\s+(\w+)\s*\{/ || - /^\s*typedef\s+enum\s+(\w+)\s*$/) { - $mode = $1; - #print "Parsing $mode\n"; - } - - elsif (/^\s*enum\s+(\w+)\s*\{/ || - /^\s*enum\s+(\w+)\s*$/) { - $mode = $1; - #print "Parsing $mode\n"; - } - - elsif (/^\s*\#ifdef\s+ICU_UCHAR_USE_DEPRECATES\b/) { - $mode = 'DEPRECATED'; - } - } - } - - $in->close(); - - # hardcode known values for the normalization quick check properties - # see unorm.h for the UNormalizationCheckResult enum - - addDatum($hash, 'NFC_QC', 'UNORM_NO', 'N'); - addDatum($hash, 'NFC_QC', 'UNORM_YES', 'Y'); - addDatum($hash, 'NFC_QC', 'UNORM_MAYBE', 'M'); - - addDatum($hash, 'NFKC_QC', 'UNORM_NO', 'N'); - addDatum($hash, 'NFKC_QC', 'UNORM_YES', 'Y'); - addDatum($hash, 'NFKC_QC', 'UNORM_MAYBE', 'M'); - - # no "maybe" values for NF[K]D - - addDatum($hash, 'NFD_QC', 'UNORM_NO', 'N'); - addDatum($hash, 'NFD_QC', 'UNORM_YES', 'Y'); - - addDatum($hash, 'NFKD_QC', 'UNORM_NO', 'N'); - addDatum($hash, 'NFKD_QC', 'UNORM_YES', 'Y'); - - $hash; -} - -#---------------------------------------------------------------------- -# Add a new value to a two-level hash. That is, given a ref to -# a hash, two keys, and a value, add $hash->{$key1}->{$key2} = $value. -sub addDatum { - my ($h, $k1, $k2, $v) = @_; - if (exists $h->{$k1}->{$k2}) { - die "Error: $k1:$k2 already set to " . - $h->{$k1}->{$k2} . ", cannot set to " . $v; - } - $h->{$k1}->{$k2} = $v; -} - -#eof |