[prev in list] [next in list] [prev in thread] [next in thread] 

List:       perl5-porters
Subject:    [perl #75462] PATCH: uniprops.t to take advantage of new EBCDIC routines in test.pl
From:       karl williamson (via RT) <perlbug-followup () perl ! org>
Date:       2010-05-30 20:15:51
Message-ID: rt-3.6.HEAD-4976-1275250551-1808.75462-75-0 () perl ! org
[Download RAW message or body]

# New Ticket Created by  karl williamson 
# Please include the string:  [perl #75462]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=75462 >


Attached

["0001-PATCH-uniprops.t-take-advantage-of-EBCDIC-test.pl.patch" (text/x-patch)]

>From 5d31d08a800960d4482b34d0bd3e4edc4eb9cfee Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@khw-desktop.(none)>
Date: Sun, 30 May 2010 14:11:52 -0600
Subject: [PATCH] PATCH: uniprops.t take advantage of EBCDIC test.pl

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 |   74 +++++--------------------------------------------
 1 files changed, 8 insertions(+), 66 deletions(-)

diff --git a/lib/unicore/mktables b/lib/unicore/mktables
index ebf8309..fc2b83b 100644
--- a/lib/unicore/mktables
+++ b/lib/unicore/mktables
@@ -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}";
         }
 
-- 
1.5.6.3



[prev in list] [next in list] [prev in thread] [next in thread]