PATCH: uniprops.t take advantage of EBCDIC test.pl
Karl Williamson [Sun, 30 May 2010 20:11:52 +0000 (14:11 -0600)]
This patch removes the partial solution to testing on EBCDIC platforms
that was in uniprops.t (generated by mktables), and replaces it with the
simple complete solution now in test.pl

lib/unicore/mktables

index ebf8309..fc2b83b 100644 (file)
@@ -3954,8 +3954,6 @@ sub trace { return main::trace(@_); }
         return $self->_add_delete('+', $start, $end, "");
     }
 
-    my $non_ASCII = (ord('A') != 65);   # Assumes test on same platform
-
     sub is_code_point_usable {
         # This used only for making the test script.  See if the input
         # proposed trial code point is one that Perl will handle.  If second
@@ -3968,15 +3966,6 @@ sub trace { return main::trace(@_); }
 
         return 0 if $code < 0;                # Never use a negative
 
-        # For non-ASCII, we shun the characters that don't have Perl encoding-
-        # independent symbols for them.  'A' is such a symbol, so is "\n".
-        return $try_hard if $non_ASCII
-                            && $code <= 0xFF
-                            && ($code >= 0x7F
-                                || ($code >= 0x0E && $code <= 0x1F)
-                                || ($code >= 0x01 && $code <= 0x06)
-                                || $code == 0x0B);
-
         # shun null.  I'm (khw) not sure why this was done, but NULL would be
         # the character very frequently used.
         return $try_hard if $code == 0x0000;
@@ -11006,7 +10995,7 @@ sub compile_perl() {
                         Initialize => $Blank + $Graph - $gc->table('Control'),
                         );
     $perl->add_match_table("PosixPrint",
-                            Description => 
+                            Description =>
                               '[- 0-9A-Za-z!"#$%&\'()*+,./:;<>?@[\\\]^_`{|}~]',
                             Initialize => $Print & $ASCII,
                             );
@@ -14111,6 +14100,11 @@ __DATA__
 use strict;
 use warnings;
 
+# If run outside the normal test suite on an ASCII platform, you can
+# just create a latin1_to_native() function that just returns its
+# inputs, because that's the only function used from test.pl
+require "test.pl";
+
 # Test qr/\X/ and the \p{} regular expression constructs.  This file is
 # constructed by mktables from the tables it generates, so if mktables is
 # buggy, this won't necessarily catch those bugs.  Tests are generated for all
@@ -14123,42 +14117,6 @@ use warnings;
 my $Tests = 0;
 my $Fails = 0;
 
-my $non_ASCII = (ord('A') != 65);
-
-# The 256 8-bit characters in ASCII ordinal order, with the ones that don't
-# have Perl names replaced by -1
-my @ascii_ordered_chars = (
-    "\0",
-    (-1) x 6,
-    "\a", "\b", "\t", "\n",
-    -1,   # No Vt
-    "\f", "\r",
-    (-1) x 18,
-    " ", "!", "\"", "#", '$', "%", "&", "'",
-    "(", ")", "*", "+", ",", "-", ".", "/",
-    "0", "1", "2", "3", "4", "5", "6", "7", "8", "9",
-    ":", ";", "<", "=", ">", "?", "@",
-    "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M",
-    "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z",
-    "[", "\\", "]", "^", "_", "`",
-    "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
-    "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z",
-    "{", "|", "}", "~",
-    (-1) x 129
-);
-
-sub ASCII_ord_to_native ($) {
-    # Converts input ordinal number to the native one, if can be done easily.
-    # Returns -1 otherwise.
-
-    my $ord = shift;
-
-    return $ord if $ord > 255 || ! $non_ASCII;
-    my $result = $ascii_ordered_chars[$ord];
-    return $result if $result eq '-1';
-    return ord($result);
-}
-
 sub Expect($$$$) {
     my $expected = shift;
     my $ord = shift;
@@ -14166,17 +14124,7 @@ sub Expect($$$$) {
     my $warning_type = shift;   # Type of warning message, like 'deprecated'
                                 # or empty if none
     my $line   = (caller)[2];
-
-    # Convert the non-ASCII code points expressible as characters to their
-    # ASCII equivalents, and skip the others.
-    $ord = ASCII_ord_to_native($ord);
-    if ($ord < 0) {
-        $Tests++;
-        print "ok $Tests - "
-              . sprintf("\"\\x{%04X}\"", $ord)
-              . " =~ $regex # Skipped: non-ASCII\n";
-        return;
-    }
+    $ord = ord(latin1_to_native(chr($ord)));
 
     # Convert the code point to hex form
     my $string = sprintf "\"\\x{%04X}\"", $ord;
@@ -14307,13 +14255,7 @@ sub Test_X($) {
         my $this_string = "";
         my $this_display = "";
         foreach my $code_point (@code_points) {
-            my $ord = ASCII_ord_to_native(hex $code_point);
-            if ($ord < 0) {
-                $Tests++;
-                print "ok $Tests - String containing $code_point =~ /(\\X)/g # Skipped: non-ASCII\n";
-                return;
-            }
-            $this_string .= chr $ord;
+            $this_string .= latin1_to_native(chr(hex $code_point));
             $this_display .= "\\x{$code_point}";
         }