Change mktables output for some tables to use hex

This makes all the tables in the lib/unicore/To directory that map from
code point to code point be formatted so that the mapped-to code point
is expressed as hexadecimal.

This allows for uniform treatment of these tables in utf8.c, and removes
the final use of strtol() in the (non-CPAN) core.  strtol() should be
avoided because it is subject to locale rules, and some older libc
implementations have been buggy.  It was used because Perl doesn't have
an efficient way of parsing a decimal number and advancing the parse
pointer to beyond it; we do have such a method for hex numbers.

The input to mktables published by Unicode is also in hex, so this now
conforms to that convention.

This also will facilitate the new work currently being done to read in
the tables that find the closing bracket given an opening one.

diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm
index 81e6710..14752ae 100644 (file)
--- a/lib/Unicode/UCD.pm
+++ b/lib/Unicode/UCD.pm
@@ -5,7 +5,7 @@ use warnings;
 no warnings 'surrogate';    # surrogates can be inputs to this
 use charnames ();
 
-our $VERSION = '0.54';
+our $VERSION = '0.55';
 
 require Exporter;
 
@@ -548,7 +548,7 @@ sub _read_table ($;$) {
     my $property = $table =~ s/\.pl//r;
     $property = $utf8::file_to_swash_name{$property};
     my $to_adjust = defined $property
-                    && $utf8::SwashInfo{$property}{'format'} eq 'a';
+                    && $utf8::SwashInfo{$property}{'format'} =~ / ^ a /x;
 
     for (split /^/m, $list) {
         my ($start, $end, $value) = / ^ (.+?) \t (.*?) \t (.+?)
@@ -556,6 +556,8 @@ sub _read_table ($;$) {
                                         $ /x;
         my $decimal_start = hex $start;
         my $decimal_end = ($end eq "") ? $decimal_start : hex $end;
+        $value = hex $value if $to_adjust
+                               && $utf8::SwashInfo{$property}{'format'} eq 'ax';
         if ($return_hash) {
             foreach my $i ($decimal_start .. $decimal_end) {
                 $return{$i} = ($to_adjust)
@@ -3360,7 +3362,7 @@ RETRY:
             # Otherwise, convert hex formatted list entries to decimal; add a
             # 'Y' map for the missing value in binary properties, or
             # otherwise, use the input map unchanged.
-            $map = ($format eq 'x')
+            $map = ($format eq 'x' || $format eq 'ax')
                 ? hex $map
                 : $format eq 'b'
                   ? 'Y'

diff --git a/lib/Unicode/UCD.t b/lib/Unicode/UCD.t
index 0ba312e..c21b7a9 100644 (file)
--- a/lib/Unicode/UCD.t
+++ b/lib/Unicode/UCD.t
@@ -1465,7 +1465,7 @@ foreach my $prop (sort keys %props) {
                 my ($start, $end, $value) = / ^ (.+?) \t (.*?) \t (.+?)
                                                 \s* ( \# .* )? $ /x;
                 $end = $start if $end eq "";
-                push @list, [ hex $start, hex $end, $value ];
+                push @list, [ hex $start, hex $end, hex $value ];
             }
 
             # For these mappings, the file contains all the simple mappings,
@@ -1523,10 +1523,10 @@ foreach my $prop (sort keys %props) {
             for my $element (@list) {
                 $official .= "\n" if $official;
                 if ($element->[1] == $element->[0]) {
-                    $official .= sprintf "%04X\t\t%s", $element->[0], $element->[2];
+                    $official .= sprintf "%04X\t\t%X", $element->[0], $element->[2];
                 }
                 else {
-                    $official .= sprintf "%04X\t%04X\t%s", $element->[0], $element->[1], $element->[2];
+                    $official .= sprintf "%04X\t%04X\t%X", $element->[0], $element->[1], $element->[2];
                 }
             }
         }
@@ -1646,6 +1646,11 @@ foreach my $prop (sort keys %props) {
                     next PROPERTY;
                 }
             }
+            elsif ($full_name =~    # These maps are in hex
+                    /(Simple_)?(Case_Folding|(Lower|Title|Upper)case_Mapping)/)
+            {
+                $invmap_ref->[$i] = sprintf("%X", $invmap_ref->[$i]);
+            }
             elsif ($format eq 'ad' || $format eq 'ale') {
 
                 # The numerics in the returned map are stored as adjusted

diff --git a/lib/unicore/mktables b/lib/unicore/mktables
index 6211028..e0996d1 100644 (file)
--- a/lib/unicore/mktables
+++ b/lib/unicore/mktables
@@ -1320,6 +1320,7 @@ my $HEX_FORMAT = 'x';
 my $RATIONAL_FORMAT = 'r';
 my $STRING_FORMAT = 's';
 my $ADJUST_FORMAT = 'a';
+my $HEX_ADJUST_FORMAT = 'ax';
 my $DECOMP_STRING_FORMAT = 'c';
 my $STRING_WHITE_SPACE_LIST = 'sw';
 
@@ -1332,6 +1333,7 @@ my %map_table_formats = (
     $RATIONAL_FORMAT => 'rational: an integer or a fraction',
     $STRING_FORMAT => 'string',
     $ADJUST_FORMAT => 'some entries need adjustment',
+    $HEX_ADJUST_FORMAT => 'mapped value in hex; some entries need adjustment',
     $DECOMP_STRING_FORMAT => 'Perl\'s internal (Normalize.pm) decomposition mapping',
     $STRING_WHITE_SPACE_LIST => 'string, but some elements are interpreted as a list; white space occurs only as list item separators'
 );
@@ -5601,6 +5603,9 @@ END
             my $next_value;
             my $offset = 0;
 
+            my $output_value_in_hex = $self->isa('Map_Table')
+                                      && $self->format eq $HEX_ADJUST_FORMAT;
+
             # Output each range as part of the here document.
             RANGE:
             for my $set ($range_list{$addr}->ranges) {
@@ -5678,7 +5683,14 @@ END
                     # output
                     if ($start != $end && ! $range_size_1) {
                         push @OUT, sprintf "%04X\t%04X", $start, $end;
-                        $OUT[-1] .= "\t$value" if $value ne "";
+                        if ($value ne "") {
+                            if ($output_value_in_hex) {
+                                $OUT[-1] .= sprintf "\t%X", $value;
+                            }
+                            else {
+                                $OUT[-1] .= "\t$value";
+                            }
+                        }
 
                         # Add a comment with the size of the range, if
                         # requested.  Expand Tabs to make sure they all start
@@ -5715,7 +5727,12 @@ END
 
                             # Here, caller is ok with default output.
                             for (my $i = $start; $i <= $end; $i++) {
-                                push @OUT, sprintf "%04X\t\t%s\n", $i, $value;
+                                if ($output_value_in_hex) {
+                                    push @OUT, sprintf "%04X\t\t%X\n", $i, $value;
+                                }
+                                else {
+                                    push @OUT, sprintf "%04X\t\t%s\n", $i, $value;
+                                }
                             }
                         }
                     }
@@ -6890,11 +6907,16 @@ END
         }
 
         # If the output is to be adjusted, the format of the table that gets
-        # output is actually 'a' instead of whatever it is stored internally
-        # as.
+        # output is actually 'a' or 'ax' instead of whatever it is stored
+        # internally as.
         my $output_adjusted = ($self->to_output_map == $OUTPUT_ADJUSTED);
         if ($output_adjusted) {
-            $format = $ADJUST_FORMAT;
+            if ($default_map eq $CODE_POINT) {
+                $format = $HEX_ADJUST_FORMAT;
+            }
+            else {
+                $format = $ADJUST_FORMAT;
+            }
         }
 
         $self->_set_format($format);

diff --git a/utf8.c b/utf8.c
index 52c3143..b798bd0 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -3424,20 +3424,10 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
            *max = *min;
 
        /* Non-binary tables have a third entry: what the first element of the
-        * range maps to */
+        * range maps to.  The map for those currently read here is in hex */
        if (wants_value) {
            if (isBLANK(*l)) {
                ++l;
-
-               /* The ToLc, etc table mappings are not in hex, and must be
-                * corrected by adding the code point to them */
-               if (typeto) {
-                   char *after_strtol = (char *) lend;
-                   *val = Strtol((char *)l, &after_strtol, 10);
-                   l = (U8 *) after_strtol;
-               }
-               else { /* Other tables are in hex, and are the correct result
-                         without tweaking */
                    flags = PERL_SCAN_SILENT_ILLDIGIT
                        | PERL_SCAN_DISALLOW_PREFIX
                        | PERL_SCAN_SILENT_NON_PORTABLE;
@@ -3447,7 +3437,6 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
                        l += numlen;
                    else
                        *val = 0;
-               }
            }
            else {
                *val = 0;