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
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;
Initialize => $Blank + $Graph - $gc->table('Control'),
);
$perl->add_match_table("PosixPrint",
- Description =>
+ Description =>
'[- 0-9A-Za-z!"#$%&\'()*+,./:;<>?@[\\\]^_`{|}~]',
Initialize => $Print & $ASCII,
);
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
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;
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;
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}";
}