Create new testing helper file

This adds t/charset_tools.pl, and populates it with 2 functions removed
from t/test.pl.  The functions are changed very slightly to use the
variables $::IS_ASCII and $::IS_EBCDIC instead of recalculating this
information.

A new function byte_utf8a_to_utf8n() is also placed in charset_tools.
This takes the bytes that form a (ASCII-platform) UTF-8 string and
convert them to the bytes that form that string on the native platform,
hence just returns the input if run on an ASCII platform.

11 files changed, 152 insertions, 44 deletions

diff --git a/MANIFEST b/MANIFEST
index 47a5400aa7..c23a59b48c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4787,6 +4787,7 @@ t/bigmem/pos.t			Check that pos() handles large offsets
 t/bigmem/read.t			Check read() handles large offsets
 t/bigmem/regexp.t		Test regular expressions with large strings
 t/bigmem/vec.t			Check vec() handles large offsets
+t/charset_tools.pl		To aid in portable testing across platforms with different character sets
 t/cmd/elsif.t			See if else-if works
 t/cmd/for.t			See if for loops work
 t/cmd/mod.t			See if statement modifiers work
diff --git a/lib/unicore/mktables b/lib/unicore/mktables
index 8899cb2e8f..ffbfe7485e 100644
--- a/lib/unicore/mktables
+++ b/lib/unicore/mktables
@@ -18605,8 +18605,8 @@ 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";
+# inputs, because that's the only function used from charset_tools.pl
+require "charset_tools.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
diff --git a/t/charset_tools.pl b/t/charset_tools.pl
new file mode 100644
index 0000000000..6abf90221c
--- /dev/null
+++ b/t/charset_tools.pl
@@ -0,0 +1,142 @@
+# Tools to aid testing across platforms with different character sets.
+
+$::IS_ASCII  = ord 'A' ==  65;
+$::IS_EBCDIC = ord 'A' == 193;
+
+# The following functions allow tests to work on both EBCDIC and ASCII-ish
+# platforms.  They convert string scalars between the native character set and
+# the set of 256 characters which is usually called Latin1.  However, they
+# will work properly with any character input, not just Latin1.
+
+sub native_to_latin1($) {
+    my $string = shift;
+
+    return $string if $::IS_ASCII;
+    my $output = "";
+    for my $i (0 .. length($string) - 1) {
+        $output .= chr(utf8::native_to_unicode(ord(substr($string, $i, 1))));
+    }
+    # Preserve utf8ness of input onto the output, even if it didn't need to be
+    # utf8
+    utf8::upgrade($output) if utf8::is_utf8($string);
+
+    return $output;
+}
+
+sub latin1_to_native($) {
+    my $string = shift;
+
+    return $string if $::IS_ASCII;
+    my $output = "";
+    for my $i (0 .. length($string) - 1) {
+        $output .= chr(ord_latin1_to_native(ord(substr($string, $i, 1))));
+    }
+    # Preserve utf8ness of input onto the output, even if it didn't need to be
+    # utf8
+    utf8::upgrade($output) if utf8::is_utf8($string);
+
+    return $output;
+}
+
+sub byte_utf8a_to_utf8n {
+    # Convert a UTF-8 byte sequence into the platform's native UTF-8
+    # equivalent, currently only UTF-8 and UTF-EBCDIC.
+
+    my @utf8_skip = (
+    # This translates a utf-8-encoded byte into how many bytes the full utf8
+    # character occupies.
+
+      # 0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F
+        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  # 0
+        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  # 1
+        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  # 2
+        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  # 3
+        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  # 4
+        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  # 5
+        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  # 6
+        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  # 7
+       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,  # 8
+       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,  # 9
+       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,  # A
+       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,  # B
+       -1,-1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,  # C
+        2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,  # D
+        3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,  # E
+        4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 7,13,  # F
+    );
+
+    my $string = shift;
+    die "Input to byte_utf8a-to_utf8n() must not be flagged UTF-8"
+                                                    if utf8::is_utf8($string);
+    return $string if $::IS_ASCII;
+    die "Expecting ASCII or EBCDIC" unless $::IS_EBCDIC;
+
+    my $length = length($string);
+    #diag($string);
+    #diag($length);
+    my $out = "";
+    for ($i = 0; $i < $length; $i++) {
+        my $byte = ord substr($string, $i, 1);
+        my $byte_count = $utf8_skip[$byte];
+        #diag($byte);
+        #diag($byte_count);
+
+        die "Illegal start byte" if $byte_count < 0;
+        if ($i + $byte_count > $length) {
+            die "Attempt to read " . $i + $byte_count - $length . " beyond end-of-string";
+        }
+
+        # Just translate UTF-8 invariants directly.
+        if ($byte_count == 1) {
+            $out .= chr utf8::unicode_to_native($byte);
+            next;
+        }
+
+        # Otherwise calculate the code point ordinal represented by the
+        # sequence beginning with this byte, using the algorithm adapted from
+        # utf8.c.  We absorb each byte in the sequence as we go along
+        my $ord = $byte & (0x1F >> ($byte_count - 2));
+        my $bytes_remaining = $byte_count - 1;
+        while ($bytes_remaining > 0) {
+            $byte = ord substr($string, ++$i, 1);
+            unless (($byte & 0xC0) == 0x80) {
+                die sprintf "byte '%X' is not a valid continuation", $byte;
+            }
+            $ord = $ord << 6 | ($byte & 0x3f);
+            $bytes_remaining--;
+        }
+        #diag($byte);
+        #diag($ord);
+
+        my $expected_bytes = $ord < 0x80
+                             ? 1
+                             : $ord < 0x800
+                               ? 2
+                               : $ord < 0x10000
+                                 ? 3
+                                 : $ord < 0x200000
+                                   ? 4
+                                   : $ord < 0x4000000
+                                     ? 5
+                                     : $ord < 0x80000000
+                                       ? 6
+                                       : 7;
+                                       #: (uv) < UTF8_QUAD_MAX ? 7 : 13 )
+
+        # Make sure is not an overlong sequence
+        if ($byte_count != $expected_bytes) {
+            die sprintf "character U+%X should occupy %d bytes, not %d",
+                                            $ord, $expected_bytes, $byte_count;
+        }
+
+        # Now that we have found the code point the original UTF-8 meant, we
+        # use the native chr function to get its native string equivalent.
+        $out .= chr utf8::unicode_to_native($ord);
+    }
+
+    utf8::encode($out); # Turn off utf8 flag.
+    #diag($out);
+    return $out;
+}
+
+1
diff --git a/t/lib/common.pl b/t/lib/common.pl
index 4ab00b1f50..367c676d51 100644
--- a/t/lib/common.pl
+++ b/t/lib/common.pl
@@ -6,7 +6,7 @@
 # to call cur_test() to find out how many this executed
 
 BEGIN {
-    require './test.pl';
+    require './test.pl'; require './charset_tools.pl';
 }
 
 use Config;
diff --git a/t/op/chop.t b/t/op/chop.t
index 3f2247fd8f..3cf873550b 100644
--- a/t/op/chop.t
+++ b/t/op/chop.t
@@ -3,7 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    require './test.pl';
+    require './test.pl'; require './charset_tools.pl';
 }
 
 plan tests => 143;
diff --git a/t/op/index.t b/t/op/index.t
index eaed4b3d65..78faeb6ac9 100644
--- a/t/op/index.t
+++ b/t/op/index.t
@@ -3,7 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    require './test.pl';
+    require './test.pl'; require './charset_tools.pl';
 }
 
 use strict;
diff --git a/t/op/lc.t b/t/op/lc.t
index e01f2b0270..bb5d4c1eac 100644
--- a/t/op/lc.t
+++ b/t/op/lc.t
@@ -6,7 +6,7 @@ BEGIN {
     chdir 't';
     @INC = '../lib';
     require Config; import Config;
-    require './test.pl';
+    require './test.pl'; require './charset_tools.pl';
     require './loc_tools.pl';   # Contains find_utf8_ctype_locale()
 }
 
diff --git a/t/re/fold_grind.t b/t/re/fold_grind.t
index 2f86113d12..65f4243a2e 100644
--- a/t/re/fold_grind.t
+++ b/t/re/fold_grind.t
@@ -5,7 +5,7 @@ binmode STDOUT, ":utf8";
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    require './test.pl';
+    require './test.pl'; require './charset_tools.pl';
     require Config; import Config;
     skip_all_if_miniperl("no dynamic loading on miniperl, no Encode nor POSIX");
     require './loc_tools.pl';
diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index 40cca4128a..3c79b87772 100644
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -17,7 +17,7 @@ $| = 1;
 BEGIN {
     chdir 't' if -d 't';
     @INC = ('../lib','.');
-    require './test.pl';
+    require './test.pl'; require './charset_tools.pl';
     skip_all_if_miniperl("miniperl can't load Tie::Hash::NamedCapture, need for %+ and %-");
 }
 
diff --git a/t/re/reg_fold.t b/t/re/reg_fold.t
index 2f739801c3..5da8cd207e 100644
--- a/t/re/reg_fold.t
+++ b/t/re/reg_fold.t
@@ -3,7 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    require './test.pl';
+    require './test.pl'; require './charset_tools.pl';
     skip_all_if_miniperl("no dynamic loading on miniperl, no File::Spec");
 }
 
diff --git a/t/test.pl b/t/test.pl
index 40e08ad0eb..2b566230a6 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -1652,39 +1652,4 @@ WATCHDOG_VIA_ALARM:
     }
 }
 
-# The following 2 functions allow tests to work on both EBCDIC and
-# ASCII-ish platforms.  They convert string scalars between the native
-# character set and the set of 256 characters which is usually called
-# Latin1.
-
-sub native_to_latin1($) {
-    my $string = shift;
-
-    return $string if $::IS_ASCII;
-    my $output = "";
-    for my $i (0 .. length($string) - 1) {
-        $output .= chr(utf8::native_to_unicode(ord(substr($string, $i, 1))));
-    }
-    # Preserve utf8ness of input onto the output, even if it didn't need to be
-    # utf8
-    utf8::upgrade($output) if utf8::is_utf8($string);
-
-    return $output;
-}
-
-sub latin1_to_native($) {
-    my $string = shift;
-
-    return $string if $::IS_ASCII;
-    my $output = "";
-    for my $i (0 .. length($string) - 1) {
-        $output .= chr(utf8::unicode_to_native(ord(substr($string, $i, 1))));
-    }
-    # Preserve utf8ness of input onto the output, even if it didn't need to be
-    # utf8
-    utf8::upgrade($output) if utf8::is_utf8($string);
-
-    return $output;
-}
-
 1;